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

Annotation of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (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 :     use Carp
9 :     ;sub new {
10 :     my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;
11 :    
12 :     $dbms = defined($dbms) ? $dbms : $FIG_Config::dbms;
13 :     $dbname = defined($dbname) ? $dbname : $FIG_Config::db;
14 :     $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;
15 :     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
16 :     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
17 :     $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;
18 :    
19 :     my $data_source = "DBI:$dbms(AutoCommit => 1):dbname=$dbname;port=$dbport";
20 :     my $dbh = DBI->connect( $data_source, $dbuser, $dbpass )
21 :     || die "ERROR: Could not connect to $data_source; ", DBI->errstr, "\n";
22 :     $dbh->{PrintError} = 1;
23 :     $dbh->{RaiseError} = 0;
24 :     if ($dbms eq "Pg")
25 :     {
26 :     $dbh->do(qq(SET "ENABLE_SEQSCAN" TO "OFF"));
27 :     $dbh->do(qq(SET DATESTYLE TO Postgres,US));
28 :     }
29 :    
30 :     bless {
31 :     _dbh => $dbh,
32 :     _dbms => $dbms,
33 :     }, $class;
34 :     }
35 :    
36 :     sub SQL {
37 :     my($self,$sql,$verbose) = @_;
38 :     my($dbh,$sth,$rc,$tmp);
39 :    
40 :     if ($verbose)
41 :     {
42 :     print STDERR "running: $sql\n";
43 :     }
44 :    
45 :     $dbh = $self->{_dbh};
46 :    
47 :     if (($sql =~ /^select/i) && ($tmp = $dbh->selectall_arrayref($sql)))
48 :     {
49 :     return $tmp;
50 :     }
51 :     else
52 :     {
53 :     return $dbh->do($sql);
54 :     # $sth = $dbh->prepare($sql)
55 :     # or die "prepare failed: $DBI::errstr";
56 :     # $sth->execute()
57 :     # or warn "execute failed: $DBI::errstr";
58 :     # return 1;
59 :     }
60 :     return undef;
61 :     }
62 :    
63 :     sub drop_table {
64 :     my $self = shift @_;
65 :     my %arg = @_;
66 :     my $tbl = $arg{tbl};
67 :     my $dbh = $self->{_dbh};
68 :     my $dbms = $self->{_dbms};
69 :     my $cmd;
70 :     if ($dbms eq "mysql") { $cmd = "DROP TABLE IF EXISTS $tbl;" ; }
71 :     else { $cmd = "DROP TABLE $tbl;" ; }
72 :     $dbh->do($cmd);
73 :     }
74 :    
75 :     sub create_table {
76 :     my $self = shift @_;
77 :     my %arg = @_;
78 :     my $tbl = $arg{tbl};
79 :     my $flds = $arg{flds};
80 :     my $dbh = $self->{_dbh};
81 :     my $dbms = $self->{_dbms};
82 :     $dbh->do("CREATE TABLE $tbl ( $flds );");
83 :     }
84 :    
85 :     sub load_table {
86 :     my $self = shift @_;
87 :     my %defaults = ( delim => "\t" );
88 :     my %arg = (%defaults, @_);
89 :     my $file = $arg{file};
90 :     my $tbl = $arg{tbl};
91 :     my $delim = $arg{delim};
92 :     my $dbh = $self->{_dbh};
93 :     my $dbms = $self->{_dbms};
94 :    
95 :     if ($file)
96 :     {
97 :     if ($dbms eq "mysql")
98 :     {
99 :     $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");
100 :     }
101 :     elsif ($dbms eq "Pg")
102 :     {
103 :     $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");
104 :     }
105 :     }
106 :     }
107 :    
108 :     sub create_index {
109 :     my $self = shift @_;
110 :     my %arg = @_;
111 :     my $tbl = $arg{tbl};
112 :     my $idx = $arg{idx};
113 :     my $flds = $arg{flds};
114 :     my $type = $arg{type};
115 :     my $dbh = $self->{_dbh};
116 :     my $dbms = $self->{_dbms};
117 :     my $cmd = "CREATE INDEX $idx ON $tbl ";
118 :     if ($type && $dbms eq "Pg")
119 :     {
120 :     $cmd .= " USING $type ";
121 :     }
122 :     $cmd .= " ( $flds );";
123 :     $dbh->do($cmd);
124 :     }
125 :    
126 :     sub DESTROY {
127 :     my($self) = @_;
128 :    
129 :     my($dbh);
130 :     if ($dbh = $self->{_dbh})
131 :     {
132 :     $dbh->disconnect;
133 :     }
134 :     }
135 :    
136 :     sub vacuum_it {
137 :     my($self,@tables) = @_;
138 :     my($table);
139 :    
140 :     my $dbh = $self->{_dbh};
141 :     my $dbms = $self->{_dbms};
142 :     if ($dbms eq "mysql")
143 :     {
144 :     return;
145 :     }
146 :    
147 :     # this chunk is for Pg (Postgres)
148 :     if (@tables == 0)
149 :     {
150 :     $self->SQL("VACUUM ANALYZE");
151 :     }
152 :     else
153 :     {
154 :     foreach $table (@tables)
155 :     {
156 :     $self->SQL("VACUUM ANALYZE $table");
157 :     }
158 :     }
159 :     }
160 :    
161 :     1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3