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

Annotation of /Clearinghouse/utils.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (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 : olson 1.1 );
24 :    
25 : olson 1.3 sub validate_package
26 :     {
27 :     my($pkg, $type) = @_;
28 :    
29 :     my %meta;
30 :    
31 :     my $stdin = new IO::Handle;
32 :     my $stdout = new IO::Handle;
33 :     my $stderr = new IO::Handle;
34 :    
35 :     my $cmd;
36 :    
37 :     if ($type eq "SUBSYSTEM" or $type eq "1-SUBSYSTEM")
38 :     {
39 :     $cmd = "$FIG_Config::bin/validate_subsystem";
40 :     }
41 :     elsif ($type eq "GENOME")
42 :     {
43 :     $cmd = "$FIG_Config::bin/validate_genome_gff";
44 :     }
45 :     else
46 :     {
47 :     die "validate_package: invalid type $type\n";
48 :     }
49 :    
50 :     my $pid = open3($stdin, $stdout, $stderr, "$cmd $pkg");
51 :    
52 :     $pid or die "Cannot run $cmd $pkg: $!";
53 :    
54 :     close($stdin);
55 :    
56 :     my @out = <$stdout>;
57 :    
58 :     my @err = <$stderr>;
59 :    
60 :     close($stdout);
61 :     close($stderr);
62 :    
63 :     waitpid($pid, 0);
64 :    
65 :     if ($?)
66 :     {
67 :     die "Validate failed with exit code $?. Error output:\n@out\n";
68 :     }
69 :    
70 :     foreach $_ (@out)
71 :     {
72 :     chomp;
73 :     my($k, $v) = split(/\t/);
74 :     $meta{$k} = $v;
75 :     }
76 :    
77 :     return %meta;
78 :     }
79 :    
80 : olson 1.2 sub get_page_header
81 :     {
82 :     my @page_header = &HTML::compute_html_header(undef, undef,
83 :     header_name => 'clearinghouse.hdr',
84 :     tail_name => 'clearinghouse.tail',
85 :     no_fig_search => 1,
86 :     no_release_info => 1);
87 :     return join("\n", @page_header);
88 :     }
89 :    
90 : olson 1.1 sub check_types {
91 :     my ($type) = @_;
92 :     my $db = db_init();
93 :    
94 :     my $ar = $db->SQL(qq(SELECT type FROM types WHERE type = '$type'));
95 :     return @$ar; #length = 0, if no rows
96 :     }
97 :    
98 :    
99 :    
100 :     sub get_lock {
101 :     my ($dbh, $name, $timeout) = @_;
102 :    
103 :     my $sth = $dbh->prepare(q{UPDATE locks set lock = 1 where name = ? and lock = 0}) or die $dbh->errstr;
104 :     my $res = $sth->execute($name);
105 :     while ($sth->rows == 0) {
106 :     if ($timeout-- == 0) {
107 :     die "Lock timout";
108 :     }
109 :     sleep 1;
110 :     my $res = $sth->execute($name);
111 :     }
112 :     }
113 :    
114 :    
115 :     sub release_lock {
116 :     my ($dbh, $name) = @_;
117 :    
118 :     my $sth = $dbh->prepare(q{UPDATE locks set lock = 0 where name = ?}) or die $dbh->errstr;
119 :     $sth->execute($name);
120 :     }
121 :    
122 :    
123 :    
124 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3