[Bio] / FigKernelPackages / DBrtns.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download) (as text)

1 : efrank 1.1 package DBrtns;
2 :    
3 :     use strict;
4 :     use DBI;
5 :     use FIG_Config;
6 :    
7 :     use Data::Dumper;
8 : overbeek 1.2 use Carp;
9 :    
10 :     sub new {
11 : efrank 1.1 my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;
12 :    
13 :     $dbms = defined($dbms) ? $dbms : $FIG_Config::dbms;
14 :     $dbname = defined($dbname) ? $dbname : $FIG_Config::db;
15 :     $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;
16 :     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
17 :     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
18 :     $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;
19 :    
20 :     my $data_source = "DBI:$dbms(AutoCommit => 1):dbname=$dbname;port=$dbport";
21 :     my $dbh = DBI->connect( $data_source, $dbuser, $dbpass )
22 :     || die "ERROR: Could not connect to $data_source; ", DBI->errstr, "\n";
23 :     $dbh->{PrintError} = 1;
24 :     $dbh->{RaiseError} = 0;
25 :     if ($dbms eq "Pg")
26 :     {
27 :     $dbh->do(qq(SET "ENABLE_SEQSCAN" TO "OFF"));
28 :     $dbh->do(qq(SET DATESTYLE TO Postgres,US));
29 :     }
30 :    
31 :     bless {
32 :     _dbh => $dbh,
33 :     _dbms => $dbms,
34 :     }, $class;
35 :     }
36 :    
37 : olson 1.3 sub set_raise_exceptions
38 :     {
39 :     my($self, $enable) = @_;
40 :     my $dbh = $self->{_dbh};
41 :     my $old = $dbh->{RaiseError};
42 :     $dbh->{RaiseError} = $enable;
43 :     return $old;
44 :     }
45 :    
46 : efrank 1.1 sub SQL {
47 :     my($self,$sql,$verbose) = @_;
48 :     my($dbh,$sth,$rc,$tmp);
49 :    
50 :     if ($verbose)
51 :     {
52 :     print STDERR "running: $sql\n";
53 :     }
54 :    
55 :     $dbh = $self->{_dbh};
56 :    
57 : olson 1.3 if ($sql =~ /^select/i)
58 : efrank 1.1 {
59 : olson 1.3 $tmp = $dbh->selectall_arrayref($sql);
60 : efrank 1.1 return $tmp;
61 :     }
62 :     else
63 :     {
64 :     return $dbh->do($sql);
65 :     # $sth = $dbh->prepare($sql)
66 :     # or die "prepare failed: $DBI::errstr";
67 :     # $sth->execute()
68 :     # or warn "execute failed: $DBI::errstr";
69 :     # return 1;
70 :     }
71 :     return undef;
72 :     }
73 :    
74 : olson 1.3 sub get_tables
75 :     {
76 :     my($self) = @_;
77 :    
78 :     my $dbh = $self->{_dbh};
79 :    
80 :     my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR
81 :    
82 :     my @tables = $dbh->tables();
83 :    
84 :     return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;
85 :     }
86 :    
87 :     sub table_exists
88 :     {
89 :     my($self, $table) = @_;
90 :    
91 :     return (grep { $table eq $_ } $self->get_tables()) > 0;
92 :     }
93 :    
94 : efrank 1.1 sub drop_table {
95 :     my $self = shift @_;
96 :     my %arg = @_;
97 :     my $tbl = $arg{tbl};
98 :     my $dbh = $self->{_dbh};
99 :     my $dbms = $self->{_dbms};
100 :     my $cmd;
101 : olson 1.3
102 :    
103 :     if ($dbms eq "mysql")
104 :     {
105 :     $cmd = "DROP TABLE IF EXISTS $tbl;" ;
106 :     }
107 :     else
108 :     {
109 :     if ($self->table_exists($tbl))
110 :     {
111 :     $cmd = "DROP TABLE $tbl;" ;
112 :     }
113 :     }
114 :     if ($cmd)
115 :     {
116 :     $dbh->do($cmd);
117 :     }
118 : efrank 1.1 }
119 :    
120 :     sub create_table {
121 :     my $self = shift @_;
122 :     my %arg = @_;
123 :     my $tbl = $arg{tbl};
124 :     my $flds = $arg{flds};
125 :     my $dbh = $self->{_dbh};
126 :     my $dbms = $self->{_dbms};
127 :     $dbh->do("CREATE TABLE $tbl ( $flds );");
128 :     }
129 :    
130 :     sub load_table {
131 :     my $self = shift @_;
132 :     my %defaults = ( delim => "\t" );
133 :     my %arg = (%defaults, @_);
134 :     my $file = $arg{file};
135 :     my $tbl = $arg{tbl};
136 :     my $delim = $arg{delim};
137 :     my $dbh = $self->{_dbh};
138 :     my $dbms = $self->{_dbms};
139 :    
140 :     if ($file)
141 :     {
142 :     if ($dbms eq "mysql")
143 :     {
144 :     $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");
145 :     }
146 :     elsif ($dbms eq "Pg")
147 :     {
148 :     $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");
149 :     }
150 :     }
151 :     }
152 :    
153 :     sub create_index {
154 :     my $self = shift @_;
155 :     my %arg = @_;
156 :     my $tbl = $arg{tbl};
157 :     my $idx = $arg{idx};
158 :     my $flds = $arg{flds};
159 :     my $type = $arg{type};
160 :     my $dbh = $self->{_dbh};
161 :     my $dbms = $self->{_dbms};
162 :     my $cmd = "CREATE INDEX $idx ON $tbl ";
163 :     if ($type && $dbms eq "Pg")
164 :     {
165 :     $cmd .= " USING $type ";
166 :     }
167 :     $cmd .= " ( $flds );";
168 :     $dbh->do($cmd);
169 :     }
170 :    
171 :     sub DESTROY {
172 :     my($self) = @_;
173 :    
174 :     my($dbh);
175 :     if ($dbh = $self->{_dbh})
176 :     {
177 :     $dbh->disconnect;
178 :     }
179 :     }
180 :    
181 :     sub vacuum_it {
182 :     my($self,@tables) = @_;
183 :     my($table);
184 :    
185 :     my $dbh = $self->{_dbh};
186 :     my $dbms = $self->{_dbms};
187 :     if ($dbms eq "mysql")
188 :     {
189 :     return;
190 :     }
191 :    
192 :     # this chunk is for Pg (Postgres)
193 :     if (@tables == 0)
194 :     {
195 :     $self->SQL("VACUUM ANALYZE");
196 :     }
197 :     else
198 :     {
199 :     foreach $table (@tables)
200 :     {
201 :     $self->SQL("VACUUM ANALYZE $table");
202 :     }
203 :     }
204 :     }
205 :    
206 :     1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3