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

Annotation of /FigWebServices/correspondence.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : olson 1.2 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : redwards 1.1 # _*_ perl _*_
19 :    
20 :     =pod
21 :    
22 :     =head1 Description
23 :    
24 :     A cgi script to control the creation of correspondence tables. This will essentially deprecate pir.cgi and many of those functions will be moved here. The general idea is to provide buttons to allow the downloading and generation of correspondence tables for several sites, including PIR, swiss-prot, kegg, and others.
25 :    
26 :     =cut
27 :    
28 :     use strict;
29 :     use FIG;
30 :     use HTML;
31 :     use raelib;
32 :     my $raelib=new raelib;
33 :     use CGI;
34 :     my $cgi=new CGI;
35 :     use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
36 :    
37 :     my $fig;
38 :     eval {
39 :     $fig = new FIG;
40 :     };
41 :    
42 :     if ($@ ne "")
43 :     {
44 :     my $err = $@;
45 :     my(@html);
46 :    
47 :     push(@html, $cgi->p("Error connecting to SEED database."));
48 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
49 :     {
50 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
51 :     }
52 :     else
53 :     {
54 :     push(@html, $cgi->pre($err));
55 :     }
56 :     &HTML::show_page($cgi, \@html, 1);
57 :     exit;
58 :     }
59 :    
60 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
61 :    
62 :     # these should probably be in FIG::Config. Oh well.
63 :     # for each off site that we want, we need three pieces of information:
64 :     # remote location (ftp or http site)
65 :     # file name to store the file as locally (usually the .dat file)
66 :     # file name for the correspondence file to create
67 :    
68 :     # note that the fileinfo hash is a hash of hashes.
69 :    
70 :     my %fileinfo=(
71 :     'PIR' =>
72 :     {
73 :     remote => "ftp://ftp.pir.georgetown.edu/pir_databases/pirsf/data/pirsfinfo.dat",
74 :     localfile => "pirsfinfo.dat",
75 :     correspondence => "pirsfcorrespondence.txt"
76 :     },
77 :     'UniProt' =>
78 :     {
79 :     remote => "http://pir2.georgetown.edu/~suzek/for_SEED/uniprot_info.gz",
80 :     localfile => "uniprot_info.gz",
81 :     correspondence => "uniprotcorrespondence.txt"
82 :     },
83 :     'Prosite' =>
84 :     {
85 :     remote => "ftp://ca.expasy.org/databases/prosite/release_with_updates/prosite.dat",
86 :     localfile => "prosite.dat",
87 :     correspondence => "prositecorrespondence.txt"
88 :     }
89 :     );
90 :    
91 :     # directory to put all the files in
92 :     my $filedir = "$FIG_Config::data/Global/correspondence/";
93 :     # this should really only be done the first time we run this script
94 :     unless (-e $filedir) {mkdir $filedir,0755}
95 :    
96 :     my $html = [];
97 :     my $user = $cgi->param('user');
98 :    
99 :    
100 :     unshift @$html, "<TITLE>The SEED - PIR comparison page</TITLE>\n";
101 :     # always put this table up so we know what we have
102 :     &show_table($fig,$cgi,$html);
103 :    
104 :     if ($cgi->param('generate_correspondence')) {
105 :     foreach my $db (keys %fileinfo) {
106 :     &generate_correspondence($db, $html, $cgi) if ($cgi->param($db) || $cgi->param("download$db"));
107 :     }
108 :     }
109 :    
110 :     &HTML::show_page($cgi,$html,1);
111 :     exit;
112 :    
113 :    
114 :    
115 :    
116 :    
117 :     sub show_table {
118 :     my ($fig,$cgi,$html)=@_;
119 :     # generate a blank page
120 :    
121 :     # Get file modification data.
122 :     # Note we will only go out and get the remote data if we have been asked for it. We don't want to do this without being asked because it may take a while
123 :     # especially if we are not online!
124 :    
125 :     # we are going to have the following columns:
126 :     # Correspondence Name Remote file mod time Local copy of remote file mod time Local copy of correspondence file mod time
127 :    
128 :     # get the file information and put it in a table
129 :     my $tab=[];
130 :     foreach my $db (keys %fileinfo) {
131 :     my @row=($cgi->checkbox(-name=>$db, -label=>''), $cgi->checkbox(-name=>"download$db", -label=>''), $db, "Not checked yet");
132 :     if ($cgi->param("get_remote_time")) {
133 :     my ($content_type, $document_length, $remotemtime, $expires, $server)=LWP::Simple::head($fileinfo{$db}->{'remote'});
134 :     $row[$#row]=$remotemtime;
135 :     }
136 :     foreach my $f ($fileinfo{$db}->{'localfile'}, $fileinfo{$db}->{'correspondence'}) {
137 :     my $localmtime="Not created yet";
138 :     # if we don't have the file yet, we don't want to panic!
139 :     if (-e "$filedir/$f") {
140 :     my @stat=stat("$filedir/$f");
141 :     $localmtime=scalar(localtime($stat[8]));
142 :     }
143 :     push @row, $localmtime;
144 :     }
145 :     push @$tab, \@row;
146 :     }
147 :    
148 :     push (@$html, $cgi->start_form(-action => "correspondence.cgi"),
149 :     $cgi->h2("Correspondence Tables Between Local and Remote Files."),
150 :     &HTML::make_table(["Correspondence", "Download", "Database", "Remote File", "Local Copy of Remote File", "Correspondence File"], $tab, "File Modification Times"),
151 :     $cgi->submit('get_remote_time', 'Check Times for Remote Files'), $cgi->submit('generate_correspondence', 'Download or Generate Correspondence'), $cgi->reset(),
152 :     );
153 :     }
154 :    
155 :    
156 :     sub generate_correspondence {
157 :     my ($db, $html, $cgi)=@_;
158 :    
159 :     my $bkj=$fig->run_in_background(sub
160 :     {
161 :     my $time=time;
162 :     print "Generating correspondence table with $db began at ", scalar(localtime($time)), "\n";
163 :     # download the file if we need to
164 :     if (!-e $fileinfo{$db}->{'localfile'} || $cgi->param("download$db")) {
165 :     my $gotit=LWP::Simple::getstore($fileinfo{$db}->{remote}, $fileinfo{$db}->{localfile});
166 :     unless ($gotit) {
167 :     print "WARNING: There was an error downloading the data from ", $fileinfo{$db}->{remote}, " to ", $fileinfo{$db}->{localfile}, "\n";
168 :     }
169 :     }
170 :     if ($cgi->param($db)) {
171 :     # generate the correspondences
172 :     # the actual generate of the correspondences is handed off to raelib
173 :     my $lines=0;
174 :     if ($db eq "Prosite") {$lines=$raelib->prositecorrespondence($filedir."/".$fileinfo{$db}->{localfile}, $filedir."/".$fileinfo{$db}->{correspondence})}
175 :     elsif ($db eq "UniProt") {$lines=$raelib->uniprotcorrespondence($filedir."/".$fileinfo{$db}->{localfile}, $filedir."/".$fileinfo{$db}->{correspondence})}
176 :     elsif ($db eq "PIR") {$lines=$raelib->pircorrespondence($filedir."/".$fileinfo{$db}->{localfile}, $filedir."/".$fileinfo{$db}->{correspondence})}
177 :    
178 :     print "Generated $lines lines of correspondence for $db\n" if ($lines);
179 :     }
180 :     print "Complete at ", scalar(localtime(time)), ". Running took ", (time-$time)/60, " minutes\n";
181 :     }
182 :     );
183 :    
184 :     push @$html, "<h2>Creating your data has started</h2>",
185 :     "<p>The job has started in the background but will likely take some time.<br />\n",
186 :     "The job has an ID of $bkj, and you can check it out from the <A href=\"/FIG/seed_ctl.cgi\">SEED Control Panel</a></p>\n";
187 :     return $html;
188 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3