[Bio] / FigWebServices / conflicted_pegs.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/conflicted_pegs.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :    
3 :     use HTML;
4 :     use FIG;
5 :     my $fig = new FIG;
6 :    
7 :     my $cgi = new CGI;
8 :    
9 :     if (0) {
10 :     my $VAR1;
11 :     eval(join("",`cat /tmp/conflicted_parms`));
12 :     $cgi = $VAR1;
13 :     # print STDERR &Dumper($cgi);
14 :     }
15 :    
16 :     if (0) {
17 :     print $cgi->header;
18 :     my @params = $cgi->param;
19 :     print "<pre>\n";
20 :     foreach $_ (@params) {
21 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
22 :     }
23 :    
24 :     if (0) {
25 :     if (open(TMP,">/tmp/conflicted_parms")) {
26 :     print TMP &Dumper($cgi);
27 :     close(TMP);
28 :     }
29 :     }
30 :     exit;
31 :     }
32 :    
33 :     my $html = [];
34 :    
35 :     my $user = $cgi->param('user');
36 :     $user =~ s/^master://;
37 :     my %conflicts;
38 :    
39 :     if (open(IN,"<$FIG_Config::global/conflicted.pegs"))
40 :     {
41 :     $line = <IN>;
42 :     while ($line && ($line =~ /^(\S+)/))
43 :     {
44 :     $peg = $1;
45 :     @set = ();
46 :     $hit = 0;
47 :     while ($line && ($line =~ /^(\S+)/) && ($1 eq $peg))
48 :     {
49 :     chomp $line;
50 :     if ($line =~ /\t$user$/) { $hit = 1 }
51 :     push(@set,[split(/\t/,$line)]);
52 :     $line = <IN>;
53 :     }
54 :     if ($hit)
55 :     {
56 :     &process_set($fig,$cgi,$user,\%conflicts,\@set);
57 :     }
58 :     }
59 :     }
60 :    
61 :    
62 :     foreach $sub (sort keys(%conflicts))
63 :     {
64 :     push(@$html,$cgi->h1($sub),"<ul>\n");
65 :     $x = $conflicts{$sub};
66 :     foreach $role (sort keys(%$x))
67 :     {
68 :     push(@$html,"<li> $role\n");
69 :     &display_for_sub_and_role($fig,$cgi,$html,$user,$x->{$role});
70 :     }
71 :     push(@$html,"</ul>\n");
72 :     }
73 :    
74 :     if (@$html == 0)
75 :     {
76 :     push(@$html,$cgi->h1('No conflicts involving your subsystems'));
77 :     }
78 :    
79 :    
80 :     &HTML::show_page($cgi,$html);
81 :    
82 :     sub process_set {
83 :     my($fig,$cgi,$user,$conflicts,$set) = @_;
84 :     my($i,$j,$x,$peg,$func,$subsystem,$role,$curator,$others);
85 :    
86 :     my @mine = grep { $_->[4] eq $user } @$set;
87 :     my @theirs = grep { $_->[4] ne $user } @$set;
88 :    
89 :     for ($i=0; ($i < @mine); $i++)
90 :     {
91 :     $x = $mine[$i];
92 :     ($peg,$func,$subsystem,$role,$curator) = @$x;
93 :     $others = [];
94 :     for ($j=0; ($j < @mine); $j++)
95 :     {
96 :     if ($j != $i)
97 :     {
98 :     push(@$others,$mine[$j]);
99 :     }
100 :     }
101 :     push(@$others,@theirs);
102 :     push(@{$conflicts->{$subsystem}->{$role}},[$peg,$func,$others]);
103 :     }
104 :     }
105 :    
106 :     sub display_for_sub_and_role {
107 :     my($fig,$cgi,$html,$user,$clashes) = @_;
108 :     my($peg,$func,$others,$col_hdrs,$tab,$x,$sub,$role,$curator);
109 :    
110 :     push(@$html,"<ul><br>\n");
111 :     foreach $peg_entry (@$clashes)
112 :     {
113 :     ($peg,$func,$others) = @$peg_entry;
114 :     $peg_link = &HTML::fid_link($cgi,$peg);
115 :     push(@$html,"<li> $peg_link &nbsp; $func\n<br>\n");
116 :     if (@$others > 0)
117 :     {
118 :     $col_hdrs = ["subsystem","role","curator"];
119 :     $tab = [];
120 :     foreach $x (@$others)
121 :     {
122 :     (undef,undef,$sub,$role,$curator) = @$x;
123 :     my $can_alter = (($user = $cgi->param('user')) && ($user eq $fig->subsystem_curator($sub)));
124 :     my $url = $cgi->a({href => "subsys.cgi?can_alter=$can_alter&user=$user&ssa_name=$sub&request=show_ssa"}, $sub);
125 :     push(@$tab,[$sub,$role,$curator]);
126 :     }
127 :     push(@$html,"<br>",&HTML::make_table($col_hdrs,$tab,"In These Subsystems"),"<br><br>");
128 :     }
129 :     push(@$html,"<br>\n");
130 :     }
131 :     push(@$html,"</ul>");
132 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3