/[cvs]/nfo/perl/libs/libdb.pm
ViewVC logotype

Annotation of /nfo/perl/libs/libdb.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Fri Jul 19 18:14:03 2002 UTC (22 years, 3 months ago) by cvsjoko
Branch: MAIN
no message

1 cvsjoko 1.1 ## --------------------------------------------------------------------------------
2     ## $Id$
3     ## --------------------------------------------------------------------------------
4     ## $Log$
5     ##
6     ## --------------------------------------------------------------------------------
7    
8     package libdb;
9    
10     use strict;
11     use warnings;
12    
13     use libp;
14     use DBI;
15    
16     require Exporter;
17     our @ISA = qw( Exporter );
18     our @EXPORT = qw(
19     testDsn hash2Sql
20     SQL_INSERT SQL_UPDATE
21     connectTarget disconnectTarget sendSql
22     dbNow
23     getDbNameByDsn sqlDbAction createSqlDb dropSqlDb
24     quotesql
25     testDsnForTables
26     );
27    
28     use constant SQL_INSERT => 10;
29     use constant SQL_UPDATE => 11;
30    
31     my $dbmeta_ref_cache;
32    
33     sub testDsn {
34     my $dsn = shift;
35     my $result;
36     if ( my $dbh = DBI->connect($dsn, '', '', {
37     PrintError => 0,
38     } ) ) {
39     $dbh->disconnect();
40     return 1;
41     }
42     }
43    
44     sub hash2Sql {
45    
46     my $table = shift;
47     my $hash = shift;
48     my $mode = shift;
49     my $crit = shift;
50    
51     my $sql;
52     if ($mode == SQL_INSERT) {
53     $sql = "INSERT INTO $table (#fields#) VALUES (#values#);";
54     }
55     if ($mode == SQL_UPDATE) {
56     $sql = "UPDATE $table SET #fields-values# WHERE $crit;";
57     }
58    
59     my (@fields, @values);
60     foreach my $key (keys %{$hash}) {
61     push @fields, $key;
62     push @values, $hash->{$key};
63     }
64     # quote each element
65     map { if (defined $_) { $_ = "'$_'" } else { $_ = "null" } } @values;
66    
67     my $fields = join(', ', @fields);
68     my $values = join(', ', @values);
69     my $fields_values = '';
70     my $fc = 0;
71     foreach (@fields) {
72     $fields_values .= $_ . '=' . $values[$fc] . ', ';
73     $fc++;
74     }
75     $fields_values = substr($fields_values, 0, -2);
76    
77     $sql =~ s/#fields#/$fields/;
78     $sql =~ s/#values#/$values/;
79     $sql =~ s/#fields-values#/$fields_values/;
80    
81     return $sql;
82     }
83    
84     sub patch_dbmeta {
85    
86     my $dbmeta = shift;
87    
88     if ($dbmeta =~ m/^dbi:/) {
89     $dbmeta = {
90     dsn => $dbmeta,
91     trace_level => 0,
92     trace_file => undef,
93     };
94     }
95    
96     return $dbmeta;
97    
98     }
99    
100     sub connectTarget {
101     my $dbmeta = shift;
102     croak "please supply a dsn or a \"dbmeta\"-hash" if (!$dbmeta);
103     $dbmeta = patch_dbmeta($dbmeta);
104     if (!$dbmeta->{connected}) {
105     if ($dbmeta->{dbh} = DBI->connect($dbmeta->{dsn})) {
106     $dbmeta->{dbh}->trace($dbmeta->{trace_level}, $dbmeta->{trace_file});
107     $dbmeta->{dbh}->{PrintError} = 0;
108     $dbmeta->{connected} = 1;
109     $dbmeta_ref_cache = $dbmeta;
110     }
111     }
112     }
113    
114     sub disconnectTarget {
115     #my $dbmeta = shift;
116     #croak "please supply a \"dbmeta\"-hash" if (!$dbmeta);
117     #$dbmeta = patch_dbmeta($dbmeta);
118     #$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect();
119     my $dbmeta = $dbmeta_ref_cache;
120     $dbmeta->{dbh} && $dbmeta->{dbh}->disconnect();
121     undef($dbmeta_ref_cache);
122     }
123    
124     sub sendSql {
125     my $sql = shift;
126     my $dbmeta_ref = shift;
127     if (!$dbmeta_ref) {
128     $dbmeta_ref = $dbmeta_ref_cache;
129     }
130     #print "sql: $sql", "\n";
131     if (!$dbmeta_ref->{connected}) {
132     print "not connected!", "\n";
133     return 0;
134     }
135     if (my $result = $dbmeta_ref->{dbh}->prepare($sql)) {
136     if ($result->execute()) {
137     return $result;
138     }
139     }
140     }
141    
142     sub dbNow {
143     #my $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
144     my $now_string = strftime("%Y-%m-%d %H:%M:%S", localtime);
145     return $now_string;
146     }
147    
148    
149     sub getDbNameByDsn {
150     my $dsn = shift;
151     $dsn =~ m/database=(.+?);/;
152     my $database_name = $1;
153     return $database_name;
154     }
155    
156     sub sqlDbAction {
157     my $dsn = shift;
158     $dsn =~ s/database=.+?;//;
159     my $sql = shift;
160     my $dbmeta = {
161     dsn => $dsn,
162     trace_level => 1,
163     trace_file => 'dbitrace',
164     };
165     connectTarget($dbmeta);
166     sendSql($sql);
167     disconnectTarget($dbmeta);
168     }
169    
170     sub createSqlDb {
171     my $dsn = shift;
172     my $dbname = getDbNameByDsn($dsn);
173     print " - creating database $dbname", "\n";
174     my $sql;
175     $sql = "CREATE DATABASE $dbname;";
176     sqlDbAction($dsn, $sql);
177     }
178     sub dropSqlDb {
179     my $dsn = shift;
180     my $dbname = getDbNameByDsn($dsn);
181     print " - dropping database $dbname", "\n";
182     my $sql;
183     $sql = "DROP DATABASE $dbname;";
184     sqlDbAction($dsn, $sql);
185     }
186    
187     sub quotesql {
188     my $string = shift;
189     $string =~ s/'/\\'/g;
190     return $string;
191     }
192    
193     sub testDsnForTables {
194     my $dsn = shift;
195     connectTarget($dsn);
196     my $result = sendSql('SHOW TABLES;');
197     my $bool_tablesHere = $result->fetchrow_hashref();
198     $result->finish();
199     disconnectTarget($dsn);
200     return 1 if ($bool_tablesHere);
201     }
202    
203     1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed