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

Annotation of /Clearinghouse/utils.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3