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

Annotation of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3