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

Annotation of /FigWebServices/correspondence.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3