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

Annotation of /FigWebServices/show_log.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :     #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 :    
20 :     use FIG;
21 :     my $fig = new FIG;
22 :    
23 :     use URI::Escape; # uri_escape
24 :     use HTML;
25 :    
26 :     use CGI;
27 :     use Tracer;
28 :    
29 :     my $cgi = new CGI;
30 :    
31 :     use Carp;
32 :    
33 :     if (0) {
34 :     my $VAR1;
35 :     eval(join("",`cat /tmp/log_parms`));
36 :     $cgi = $VAR1;
37 :     # print STDERR &Dumper($cgi);
38 :     }
39 :    
40 :     if (0) {
41 :     print $cgi->header;
42 :     my @params = $cgi->param;
43 :     print "<pre>\n";
44 :     foreach $_ (@params) {
45 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
46 :     }
47 :    
48 :     if (0) {
49 :     if (open(TMP,">/tmp/log_parms")) {
50 :     print TMP &Dumper($cgi);
51 :     close(TMP);
52 :     }
53 :     }
54 :     exit;
55 :     }
56 :    
57 :     my $html = [];
58 :    
59 :    
60 :    
61 :     if ($request = $cgi->param('request'))
62 :     {
63 :     &process_request($fig,$cgi,$html,$request);
64 :     exit;
65 :     }
66 :     #### no request, show initial form ####A
67 :    
68 :     push(@$html,$cgi->h1("Genome Log"));
69 :     if (open(INDEX,"<$FIG_Config::data/Logs/GenomeLog/index"))
70 :     {
71 :     my @tmp;
72 :     my $col_hdrs = ["Genome"];
73 :     while (defined($_ = <INDEX>))
74 :     {
75 :     if ($_ =~ /^(\d+)\t(\S.*\S)/)
76 :     {
77 :     my($i,$gs) = ($1,$2);
78 : overbeek 1.2 my $gsE = $cgi->escape($gs);
79 :     my $link = $cgi->url(-relative => 1) . "?request=show_log&which=$i&gs=$gsE";
80 : overbeek 1.1 my $url = "<a href=$link>$gs</a>";
81 :    
82 :     push(@tmp,[$gs,$url]);
83 :     }
84 :     }
85 :     close(INDEX);
86 :     @tmp = sort { $a->[0] cmp $b->[0] } @tmp;
87 :     $tab = [ map { [$_->[1]] } @tmp];
88 :    
89 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Genomes For Which Logs Exist"));
90 :     }
91 :     else
92 :     {
93 :     push(@$html,$cgi->h2("No log exists"));
94 :     }
95 :    
96 :     &HTML::show_page($cgi,$html);
97 :    
98 :     sub process_request {
99 :     my($fig,$cgi,$html,$request) = @_;
100 :     my($which,$gs);
101 :    
102 :     if (($request eq "show_log") &&
103 :     ($which = $cgi->param('which')) &&
104 : overbeek 1.2 ($gs = $cgi->unescape($cgi->param('gs'))) &&
105 : overbeek 1.1 open(LOG,"<$FIG_Config::data/Logs/GenomeLog/Entries/$which/log"))
106 :     {
107 :     $/ = "\n//\n";
108 :     while (defined($log_entry = <LOG>))
109 :     {
110 :     chomp $log_entry;
111 :     my($ts,$who,$genome,@msg) = split(/\n/,$log_entry);
112 : overbeek 1.2 push(@$tab,[$fig->epoch_to_readable($ts),$who,$genome,&make_readable_extra($fig,$cgi,\@msg)]);
113 : overbeek 1.1 }
114 :     $/ = "\n";
115 :     push(@$html,&HTML::make_table(["When","Who","Genome","What"],$tab,"Events: $gs"));
116 :     }
117 : overbeek 1.2 elsif (($request eq "display_map") && ($map = $cgi->param('map')) && (-s $map))
118 :     {
119 :     &show_map($fig,$cgi,$html,$map);
120 :     }
121 : overbeek 1.1 else
122 :     {
123 :     push(@$html,$cgi->h2("Invalid request"));
124 :     }
125 :     &HTML::show_page($cgi,$html);
126 :     }
127 :    
128 : overbeek 1.2 sub make_readable_extra {
129 :     my($fig,$cgi,$msg) = @_;
130 :     my($hdr,$genomeF,$map);
131 :    
132 :     if (($msg->[0] =~ /^(Replaced genome \d+\.\d+ with \d+\.\d+)/) && ($hdr = $1) &&
133 :     ($msg->[2] =~ /^(\S[^,]+),(\S[^,]+)/) && ($genomeF = $1) && ($map = $2))
134 :     {
135 :     my $mapE = $cgi->escape($map);
136 :     my $link = $cgi->url(-relative => 1) . "?request=display_map&map=$mapE";
137 :     my $url = "<a href=$link>map</a>";
138 :     return join("<br>",($hdr,$msg->[1],"Tarred Organism=$genomeF",$url));
139 :     }
140 : overbeek 1.3 elsif (($msg->[0] =~ /^Logged correspondence/) && ($map = $msg->[1]))
141 :     {
142 :     my $mapE = $cgi->escape($map);
143 :     my $link = $cgi->url(-relative => 1) . "?request=display_map&map=$mapE";
144 :     my $url = "<a href=$link>map</a>";
145 :     return join("<br>",($msg->[0],$url));
146 :     }
147 :    
148 : overbeek 1.2 return join("<br>",@$msg);
149 :     }
150 :    
151 :     sub show_map {
152 :     my($fig,$cgi,$html,$map) = @_;
153 :    
154 :     my $tmpD = "untar$$";
155 :     if (-d $tmpD) { system "/bin/rm -r $tmpD" }
156 :     mkdir($tmpD,0777) || die "could not make $tmpD";
157 :     system "cd $tmpD; tar xzf $map";
158 :     opendir(DIR,$tmpD);
159 :     my @expanded = grep { $_ !~ /^\./ } readdir(DIR);
160 :     closedir(DIR);
161 :     if ((@expanded == 1) && (-s "$tmpD/$expanded[0]"))
162 :     {
163 :     my($x,$y);
164 :     my @entries = sort { $a =~ /^fig\|\d+\.\d+\.[^\.]+\.(\d+)/; $x = $1;
165 :     $b =~ /^fig\|\d+\.\d+\.[^\.]+\.(\d+)/; $y = $1;
166 :     $x <=> $y
167 :     }
168 :     `cat $tmpD/$expanded[0]`;
169 :    
170 :     push(@$html,"<pre>\n",@entries,"</pre>\n");
171 :     }
172 :     system "rm -r $tmpD";
173 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3