[Bio] / Clearinghouse / utils.pm Repository:
ViewVC logotype

Annotation of /Clearinghouse/utils.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (view) (download) (as text)

1 : olson 1.1
2 :     #
3 :     # Clearinghouse utility functions.
4 :     #
5 :    
6 :     use strict;
7 :     use base 'Exporter';
8 :    
9 : olson 1.3 use IO::Handle;
10 :     use IPC::Open3;
11 : olson 1.7 use FileHandle;
12 : olson 1.2 use HTML;
13 : olson 1.1 use Clearinghouse::ch_database;
14 : olson 1.3 use FIG;
15 :     use FIG_Config;
16 :    
17 :     our $fig;
18 : olson 1.7 our $log_fh;
19 : olson 1.1
20 :     our @EXPORT = qw(check_types
21 : disz 1.5 lock_init
22 :     type_init
23 : olson 1.2 get_lock
24 :     release_lock
25 :     get_page_header
26 : olson 1.3 validate_package
27 : disz 1.4 make_accession
28 :     insert_ch_record
29 :     insert_meta_data
30 :     insert_package_location
31 : disz 1.6 check_for_duplicates
32 : olson 1.7 log
33 : olson 1.1 );
34 :    
35 : olson 1.7 sub ch_log
36 :     {
37 :     my($str) = @_;
38 :     if (not defined($log_fh))
39 :     {
40 :     &FIG::verify_dir("$FIG_Config::fig/var");
41 :     $log_fh = new FileHandle ">>$FIG_Config::fig/var/clearinghouse.log";
42 :     $log_fh->autoflush(1);
43 :     }
44 :    
45 :     print $log_fh $str;
46 :     }
47 :    
48 : olson 1.3 sub validate_package
49 :     {
50 :     my($pkg, $type) = @_;
51 :    
52 :     my %meta;
53 :    
54 :     my $stdin = new IO::Handle;
55 :     my $stdout = new IO::Handle;
56 :     my $stderr = new IO::Handle;
57 :    
58 :     my $cmd;
59 :    
60 :     if ($type eq "SUBSYSTEM" or $type eq "1-SUBSYSTEM")
61 :     {
62 :     $cmd = "$FIG_Config::bin/validate_subsystem";
63 :     }
64 :     elsif ($type eq "GENOME")
65 :     {
66 :     $cmd = "$FIG_Config::bin/validate_genome_gff";
67 :     }
68 :     else
69 :     {
70 :     die "validate_package: invalid type $type\n";
71 :     }
72 :    
73 :     my $pid = open3($stdin, $stdout, $stderr, "$cmd $pkg");
74 :    
75 :     $pid or die "Cannot run $cmd $pkg: $!";
76 :    
77 :     close($stdin);
78 :    
79 :     my @out = <$stdout>;
80 :    
81 :     my @err = <$stderr>;
82 :    
83 :     close($stdout);
84 :     close($stderr);
85 :    
86 :     waitpid($pid, 0);
87 :    
88 :     if ($?)
89 :     {
90 :     die "Validate failed with exit code $?. Error output:\n@out\n";
91 :     }
92 :    
93 :     foreach $_ (@out)
94 :     {
95 :     chomp;
96 :     my($k, $v) = split(/\t/);
97 :     $meta{$k} = $v;
98 :     }
99 :    
100 :     return %meta;
101 :     }
102 :    
103 : olson 1.2 sub get_page_header
104 :     {
105 :     my @page_header = &HTML::compute_html_header(undef, undef,
106 :     header_name => 'clearinghouse.hdr',
107 :     tail_name => 'clearinghouse.tail',
108 :     no_fig_search => 1,
109 :     no_release_info => 1);
110 :     return join("\n", @page_header);
111 :     }
112 :    
113 : olson 1.1 sub check_types {
114 :     my ($type) = @_;
115 :     my $db = db_init();
116 :    
117 :     my $ar = $db->SQL(qq(SELECT type FROM types WHERE type = '$type'));
118 :     return @$ar; #length = 0, if no rows
119 :     }
120 :    
121 : disz 1.6 sub check_for_duplicates {
122 :     my ($type, $meta_data) = @_;
123 :     my $db = db_init();
124 :     if ($type eq 'GENOME') {
125 :     return check_for_duplicate_genome($meta_data);
126 :     } elsif ($type eq 'SUBSYSTEM') {
127 :     return check_for_duplicate_subsystem($meta_data);
128 :     } else {
129 :     return 1;
130 :     }
131 :     }
132 :    
133 :     sub check_for_duplicate_genome {
134 :     my ($meta_data) = @_;
135 :     my $genome_id;
136 :    
137 :    
138 :     my @md = split (/\n/, $meta_data);
139 :     for my $i (@md) {
140 :     my ($tag, $value) = split(/\t/, $i);
141 :     if ($tag eq 'genome_id') {
142 :     $genome_id = $value;
143 :     last;
144 :     }
145 :     }
146 :    
147 :     my $db = db_init();
148 :     my $ar = $db->SQL(qq(SELECT ch_id FROM meta_data WHERE tag = 'genome_id' AND value = '$genome_id'));
149 :     return @$ar; #length = 0, if no rows
150 :     }
151 :    
152 :     sub check_for_duplicate_subsystem {
153 :     my ($meta_data) = @_;
154 :     my ($name, $version);
155 :     my @md = split (/\n/, $meta_data);
156 :     for my $i (@md) {
157 :     my ($tag, $value) = split(/\t/, $i);
158 :     if ($tag eq 'name') {
159 :     $name = $value;
160 :     }
161 :     if ($tag eq 'version') {
162 :     $version = $value;
163 :     }
164 :     }
165 :     my $db = db_init();
166 :    
167 :     print STDERR "NAME $name, VERSION $version\n";
168 :     my $ar = $db->SQL(qq(SELECT c.id FROM meta_data m1, meta_data m2, clearing_house c WHERE (c.id = m1.ch_id AND c.id = m2.ch_id AND
169 :     m1.tag = 'name' and m1.value = '$name' AND
170 :     m2.tag = 'version' and m2.value = '$version' AND
171 :     c.type = 'SUBSYSTEM')));
172 :    
173 :     return @$ar; #length = 0, if no rows
174 :     }
175 :    
176 :    
177 :    
178 : disz 1.5 sub lock_init {
179 :     my ($dbh) = @_;
180 :    
181 :     my $sth = $dbh->{_dbh}->prepare(q(INSERT into locks (name, lock)
182 :     VALUES (?, ?)
183 :     )) or die $dbh->{_dbh}->errstr;
184 :     $sth->execute("genome", 0);
185 :     $sth->execute("feature", 0);
186 :     }
187 :    
188 :     sub type_init {
189 :     my ($dbh) = @_;
190 :    
191 :     my $sth = $dbh->{_dbh}->prepare(q(INSERT into types (type)
192 :     VALUES (?)
193 :     )) or die $dbh->{_dbh}->errstr;
194 :    
195 :     # Initialize the known set of types.
196 :     #
197 :    
198 :     $sth->execute("GENOME");
199 :     $sth->execute("ANNOTATION");
200 :     $sth->execute("SUBSYSTEM");
201 :     $sth->execute("1-SUBSYSTEM");
202 :     $sth->execute("SIMS");
203 :     $sth->execute("FEATURE");
204 :     }
205 : olson 1.1
206 :    
207 :     sub get_lock {
208 :     my ($dbh, $name, $timeout) = @_;
209 :    
210 :     my $sth = $dbh->prepare(q{UPDATE locks set lock = 1 where name = ? and lock = 0}) or die $dbh->errstr;
211 :     my $res = $sth->execute($name);
212 :     while ($sth->rows == 0) {
213 :     if ($timeout-- == 0) {
214 :     die "Lock timout";
215 :     }
216 :     sleep 1;
217 :     my $res = $sth->execute($name);
218 :     }
219 :     }
220 :    
221 :    
222 :     sub release_lock {
223 :     my ($dbh, $name) = @_;
224 :    
225 :     my $sth = $dbh->prepare(q{UPDATE locks set lock = 0 where name = ?}) or die $dbh->errstr;
226 :     $sth->execute($name);
227 :     }
228 :    
229 :    
230 : disz 1.4 sub make_accession {
231 :     my ($db, $who, $source) = @_;
232 :     my $dbh = $db->{_dbh};
233 :     my $timestamp = time();
234 :     my $accession_id;
235 :    
236 :     my $sth = $dbh->prepare(q{INSERT into accession (who, accession_date, comments, source) VALUES (?, ?,?,?)}) or die $dbh->errstr;
237 :     $sth->execute($who, $timestamp, '', $source) or die $dbh->errstr;
238 :     #check the result here. check what execute returne wrt errors
239 :     my $accession_id = $db->get_inserted_id('accession', $sth);
240 :     return $accession_id;
241 :     }
242 :    
243 :     sub insert_ch_record {
244 :     my ($db, $accession_id, $type, $meta_data, $description) = @_;
245 :     my $dbh = $db->{_dbh};
246 :     my $sth = $dbh->prepare(q{INSERT into clearing_house (accession_id, type, meta_data, description) VALUES (?,?,?,?) }) or die $dbh->errstr;
247 :     $sth->execute($accession_id, $type, $meta_data, $description);
248 :     my $ch_id = $db->get_inserted_id('clearing_house', $sth);
249 :     return $ch_id;
250 :     }
251 :    
252 :    
253 :     sub insert_meta_data {
254 :     my ($dbh, $ch_id, $meta_data) = @_;
255 :    
256 :     my $sth = $dbh->prepare(q{INSERT into meta_data (ch_id, tag, value) VALUES (?, ?,?)}) or die $dbh->errstr;
257 :     my @md = split (/\n/, $meta_data);
258 :     for my $i (@md) {
259 :     my ($tag, $value) = split(/\t/, $i);
260 :     $sth->execute($ch_id, $tag, $value);
261 :     }
262 :     }
263 :    
264 :     sub insert_package_location {
265 :     my ($dbh, $ch_id, $path) = @_;
266 :     my $sth = $dbh->prepare(q{INSERT into package_location (ch_id, pathname) VALUES (?,?)}) or die $dbh->errstr;
267 :     $sth->execute($ch_id, $path);
268 :    
269 :     }
270 :    
271 :    
272 : olson 1.1
273 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3