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

Annotation of /Clearinghouse/utils.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (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 : olson 1.1 );
30 :    
31 : olson 1.3 sub validate_package
32 :     {
33 :     my($pkg, $type) = @_;
34 :    
35 :     my %meta;
36 :    
37 :     my $stdin = new IO::Handle;
38 :     my $stdout = new IO::Handle;
39 :     my $stderr = new IO::Handle;
40 :    
41 :     my $cmd;
42 :    
43 :     if ($type eq "SUBSYSTEM" or $type eq "1-SUBSYSTEM")
44 :     {
45 :     $cmd = "$FIG_Config::bin/validate_subsystem";
46 :     }
47 :     elsif ($type eq "GENOME")
48 :     {
49 :     $cmd = "$FIG_Config::bin/validate_genome_gff";
50 :     }
51 :     else
52 :     {
53 :     die "validate_package: invalid type $type\n";
54 :     }
55 :    
56 :     my $pid = open3($stdin, $stdout, $stderr, "$cmd $pkg");
57 :    
58 :     $pid or die "Cannot run $cmd $pkg: $!";
59 :    
60 :     close($stdin);
61 :    
62 :     my @out = <$stdout>;
63 :    
64 :     my @err = <$stderr>;
65 :    
66 :     close($stdout);
67 :     close($stderr);
68 :    
69 :     waitpid($pid, 0);
70 :    
71 :     if ($?)
72 :     {
73 :     die "Validate failed with exit code $?. Error output:\n@out\n";
74 :     }
75 :    
76 :     foreach $_ (@out)
77 :     {
78 :     chomp;
79 :     my($k, $v) = split(/\t/);
80 :     $meta{$k} = $v;
81 :     }
82 :    
83 :     return %meta;
84 :     }
85 :    
86 : olson 1.2 sub get_page_header
87 :     {
88 :     my @page_header = &HTML::compute_html_header(undef, undef,
89 :     header_name => 'clearinghouse.hdr',
90 :     tail_name => 'clearinghouse.tail',
91 :     no_fig_search => 1,
92 :     no_release_info => 1);
93 :     return join("\n", @page_header);
94 :     }
95 :    
96 : olson 1.1 sub check_types {
97 :     my ($type) = @_;
98 :     my $db = db_init();
99 :    
100 :     my $ar = $db->SQL(qq(SELECT type FROM types WHERE type = '$type'));
101 :     return @$ar; #length = 0, if no rows
102 :     }
103 :    
104 : disz 1.5 sub lock_init {
105 :     my ($dbh) = @_;
106 :    
107 :     my $sth = $dbh->{_dbh}->prepare(q(INSERT into locks (name, lock)
108 :     VALUES (?, ?)
109 :     )) or die $dbh->{_dbh}->errstr;
110 :     $sth->execute("genome", 0);
111 :     $sth->execute("feature", 0);
112 :     }
113 :    
114 :     sub type_init {
115 :     my ($dbh) = @_;
116 :    
117 :     my $sth = $dbh->{_dbh}->prepare(q(INSERT into types (type)
118 :     VALUES (?)
119 :     )) or die $dbh->{_dbh}->errstr;
120 :    
121 :     # Initialize the known set of types.
122 :     #
123 :    
124 :     $sth->execute("GENOME");
125 :     $sth->execute("ANNOTATION");
126 :     $sth->execute("SUBSYSTEM");
127 :     $sth->execute("1-SUBSYSTEM");
128 :     $sth->execute("SIMS");
129 :     $sth->execute("FEATURE");
130 :     }
131 : olson 1.1
132 :    
133 :     sub get_lock {
134 :     my ($dbh, $name, $timeout) = @_;
135 :    
136 :     my $sth = $dbh->prepare(q{UPDATE locks set lock = 1 where name = ? and lock = 0}) or die $dbh->errstr;
137 :     my $res = $sth->execute($name);
138 :     while ($sth->rows == 0) {
139 :     if ($timeout-- == 0) {
140 :     die "Lock timout";
141 :     }
142 :     sleep 1;
143 :     my $res = $sth->execute($name);
144 :     }
145 :     }
146 :    
147 :    
148 :     sub release_lock {
149 :     my ($dbh, $name) = @_;
150 :    
151 :     my $sth = $dbh->prepare(q{UPDATE locks set lock = 0 where name = ?}) or die $dbh->errstr;
152 :     $sth->execute($name);
153 :     }
154 :    
155 :    
156 : disz 1.4 sub make_accession {
157 :     my ($db, $who, $source) = @_;
158 :     my $dbh = $db->{_dbh};
159 :     my $timestamp = time();
160 :     my $accession_id;
161 :    
162 :     my $sth = $dbh->prepare(q{INSERT into accession (who, accession_date, comments, source) VALUES (?, ?,?,?)}) or die $dbh->errstr;
163 :     $sth->execute($who, $timestamp, '', $source) or die $dbh->errstr;
164 :     #check the result here. check what execute returne wrt errors
165 :     my $accession_id = $db->get_inserted_id('accession', $sth);
166 :     return $accession_id;
167 :     }
168 :    
169 :     sub insert_ch_record {
170 :     my ($db, $accession_id, $type, $meta_data, $description) = @_;
171 :     my $dbh = $db->{_dbh};
172 :     my $sth = $dbh->prepare(q{INSERT into clearing_house (accession_id, type, meta_data, description) VALUES (?,?,?,?) }) or die $dbh->errstr;
173 :     $sth->execute($accession_id, $type, $meta_data, $description);
174 :     my $ch_id = $db->get_inserted_id('clearing_house', $sth);
175 :     return $ch_id;
176 :     }
177 :    
178 :    
179 :     sub insert_meta_data {
180 :     my ($dbh, $ch_id, $meta_data) = @_;
181 :    
182 :     my $sth = $dbh->prepare(q{INSERT into meta_data (ch_id, tag, value) VALUES (?, ?,?)}) or die $dbh->errstr;
183 :     my @md = split (/\n/, $meta_data);
184 :     for my $i (@md) {
185 :     my ($tag, $value) = split(/\t/, $i);
186 :     $sth->execute($ch_id, $tag, $value);
187 :     }
188 :     }
189 :    
190 :     sub insert_package_location {
191 :     my ($dbh, $ch_id, $path) = @_;
192 :     my $sth = $dbh->prepare(q{INSERT into package_location (ch_id, pathname) VALUES (?,?)}) or die $dbh->errstr;
193 :     $sth->execute($ch_id, $path);
194 :    
195 :     }
196 :    
197 :    
198 : olson 1.1
199 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3