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

Annotation of /Clearinghouse/utils.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3