0
|
1 #!/project/bioperl/perl-5.10.1-sles11/bin/perl -w
|
|
2
|
|
3 ##
|
|
4 #
|
|
5 # This file requires that a database connection be configured and
|
|
6 # connected to the scalar $dbh
|
|
7 #
|
|
8 ##
|
|
9
|
|
10 if (!defined($project_table_name)) {
|
|
11 $project_table_name = "TAPDANCE_project_master";
|
|
12 }
|
|
13 return 1;
|
|
14
|
|
15 sub project_table_check {
|
|
16 my $create_string = "CREATE TABLE IF NOT EXISTS " . $project_table_name . " (name VARCHAR(255) NOT NULL, insert_gen TIMESTAMP, cis_call TIMESTAMP)";
|
|
17 my $sth = $dbh->prepare($create_string);
|
|
18 $sth->execute;
|
|
19 }
|
|
20
|
|
21
|
|
22 sub project_exists {
|
|
23 my ($proj_name) = @_;
|
|
24 &project_table_check();
|
|
25 my $test_string = "SELECT COUNT(name) FROM " . $project_table_name . " WHERE name = '" . $proj_name . "'";
|
|
26 my $sth = $dbh->prepare($test_string);
|
|
27 $sth->execute;
|
|
28 (@row) = $sth->fetchrow_array;
|
|
29 return $row[0] > 0;
|
|
30 }
|
|
31
|
|
32 sub update_project {
|
|
33 &project_table_check();
|
|
34 my ($proj_name, $insert_gen, $cis_call) = @_;
|
|
35 my $update_string = "UPDATE " . $project_table_name . " SET";
|
|
36 my $prefix = " ";
|
|
37 if ($insert_gen) {
|
|
38 $update_string = $update_string . $prefix . "insert_gen = NOW()";
|
|
39 $prefix = ", "
|
|
40 }
|
|
41 if ($cis_call) {
|
|
42 $update_string = $update_string . $prefix . "cis_call = NOW()";
|
|
43 }
|
|
44 $update_string = $update_string . " WHERE name = '" . $proj_name . "'";
|
|
45 my $sth = $dbh->prepare($update_string);
|
|
46 $sth->execute;
|
|
47 }
|
|
48
|
|
49 sub insert_project {
|
|
50 &project_table_check();
|
|
51 my ($proj_name, $insert_gen, $cis_call) = @_;
|
|
52 my $insert_string = "INSERT INTO " . $project_table_name;
|
|
53 my $insert_cols_string = " (name";
|
|
54 my $insert_vals_string = " VALUES('" . $proj_name . "'";
|
|
55 if ($insert_gen) {
|
|
56 $insert_cols_string = $insert_cols_string . ", insert_gen";
|
|
57 $insert_vals_string = $insert_vals_string . ", NOW()";
|
|
58 }
|
|
59 if ($cis_call) {
|
|
60 $insert_cols_string = $insert_cols_string . ", cis_call";
|
|
61 $insert_vals_string = $insert_vals_string . ", NOW()";
|
|
62 }
|
|
63 $insert_cols_string = $insert_cols_string . ") ";
|
|
64 $insert_vals_string = $insert_vals_string . ") ";
|
|
65 $insert_string = $insert_string . $insert_cols_string . $insert_vals_string;
|
|
66 my $sth = $dbh->prepare($insert_string);
|
|
67 $sth->execute;
|
|
68 }
|
|
69
|
|
70 sub delete_project {
|
|
71 &project_table_check();
|
|
72 my ($proj_name) = @_;
|
|
73 my $delete_string = "DELETE FROM " . $project_table_name . " WHERE name = '" . $proj_name . "'";
|
|
74 my $sth = $dbh->prepare($delete_string);
|
|
75 $sth->execute;
|
|
76 }
|
|
77
|
|
78 sub set_project_status {
|
|
79 my ($proj_name, $insert_gen, $cis_call) = @_;
|
|
80 if (&project_exists($proj_name)) {
|
|
81 &update_project($proj_name, $insert_gen, $cis_call);
|
|
82 } else {
|
|
83 &insert_project($proj_name, $insert_gen, $cis_call);
|
|
84 }
|
|
85 }
|
|
86
|
|
87 sub get_project_list {
|
|
88 my ($user_name, $query_type, @tags) = @_;
|
|
89 &project_table_check();
|
|
90 my $select_string = "SELECT name FROM " . $project_table_name . " WHERE name LIKE '" . $user_name . "%'";
|
|
91 my $sth = $dbh->prepare($select_string);
|
|
92 $sth->execute();
|
|
93 my @projects = ();
|
|
94 while ((@row) = $sth->fetchrow_array) {
|
|
95 if ($query_type eq "all") {
|
|
96 push @projects, $row[0];
|
|
97 } else {
|
|
98 my $conjunctive;
|
|
99 #if ($query_type eq "union") {
|
|
100 #$conjunctive = "AND";
|
|
101 #} elsif ($query_type eq "join") {
|
|
102 $conjunctive = "OR";
|
|
103 #}
|
|
104 $select_string = "SELECT COUNT(*) from metadata_$row[0] where descriptor LIKE '%";
|
|
105 $select_string = $select_string . join("%' " . $conjunctive . " descriptor LIKE '%", @tags) . "%'";
|
|
106 #print $select_string . "\n";
|
|
107 my $sth2 = $dbh->prepare($select_string);
|
|
108 $sth2->execute;
|
|
109 while ((@row2) = $sth2->fetchrow_array) {
|
|
110 if ($row2[0] > 0) {
|
|
111 push @projects, $row[0];
|
|
112 }
|
|
113 }
|
|
114 }
|
|
115 }
|
|
116 return \@projects;
|
|
117 }
|