| DBIx-Wrap documentation | Contained in the DBIx-Wrap distribution. |
DBIx::Wrap - Object oriented wrapper around DBI.
use DBIx::Wrap;
my $dsn = "DBI:mysql:database=accounts";
$db = DBIx::Wrap->new (DSN => $dsn, User => 'jowaxman',
Password => 'plipplop');
# select
# Return a hash reference.
$user = $db->select (Table => 'passwd',
Fields => 'gcos,homedir,shell',
Where => "username='jowaxman'");
$gcos = $user->{gcos};
# Set the table.
$db->table ('employees');
# Return an array of values.
@info = $db->select (Fields => 'ssn,address,phone',
Where => "ssn='123456789'");
$ssn = $info[1];
# iterate
my $id;
while (my ($username, $gcos) = $db->each (\$id,
Tables => 'passwd,employees',
Fields => 'passwd.username,address,phone',
Where => "passwd.username=employees.username and
employees.status='fulltime'")) {
# Note, could have done
# while (my $employee = $db->each (...
# to get a hash.
}
# insert
$db->insert (Table => 'passwd',
Values => {username => $username,
uid => $uid,
gcos => $gcos,
...});
# delete
$db->delete (Table => 'passwd',
Where => "username='jowaxman'");
This module is a wrapper around the DBI database class. It simplifies database querying. You may use this as a base class for a derived class that operates on a specific kind of database.
You must give the constructor the named parameters DSN, User, and Password so DBI can connect to the database.
DBIx::Wrap provides the public method error to do simple error
handling. If an argument is given (the error), it is stored, otherwise,
the stored error is returned.
error may be called as a package method (e.g., DBIx::Wrap->error
($error); or as an object method (e.g., $db->error ($error);. If
it is called as a package method, the error is stored as a package
variable. If it is called as an object method, the error is stored as a
private variable.
my $sql = $self->_prepare_sql ('select', \%params);
This private method prepares an sql statement given a set of named parameters. See the DBI or SQL documentation for more information on valid SQL phrases. The following named parameters are used:
Specified the database table or tables. You can fix the table by using the method table (see below).
Single field name or comma separated list of field names.
A valid SQL WHERE clause.
An anonymous hash containing column name/value pairs.
The ordering criteria.
A constraint limiting the number of rows returned.
$self->table ('passwd');
This method fixes the table so that you do not have to specify the named parameter Table in any database method. This is very useful for repeated operations on the same table or when deriving a class that operates only on one table (see DB::passwd, for example).
$user = $db->select (Table => 'passwd',
Where => "username='jowaxman'");
@info = $db->select (Table => 'passwd',
Fields => 'gcos,homedir,shell',
Where => "uid=12345");
This method performs an SQL SELECT operation. See _prepare_sql for the named parameters that are used.
If returning to a scalar, a reference to a hash containing column name/value pairs is returned. If returning to an array, a list of values in the same order as the fields specified in the named parameter Fields is returned. If no named parameter Fields is given, all fields are returned.
Note that if multiple entries match the WHERE clause, only the first will be returned.
my $id;
while (my ($username, $gcos) = $db->each (\$id,
Table => 'passwd',
Fields => 'username,gcos',
)) {
# Note, could have done
# while (my $user = $db->each (...
# to get a hash.
}
Note that this method is deprecated. Use the iterator method.
This method is used for iterating through multiple database entries. See _prepare_sql for the named parameters used.
You must pass as the first arguement a reference to a scalar to store an id for the iteration. This allows iterations to be nested without conflict.
my $iterator = $db->iterator (Table => 'passwd',
Fields => 'username,gcos,homedir',
Where => "homedir like '/home/j/%");
while (my ($username, $gcos, $homedir) = $iterator->next ()) {
...
}
This method returns an iterator object used to iterate over multiple rows returned by an SQL query. See _prepare_sql for the named parameters used.
The iterator method next is used to return the first or next row. If
next is called in an array context, an array of column values for the
specified fields is returned. If next is called in a scalar context, a
reference to a hash containing the name/values of the requested columns is
returned.
$db->insert (Table => 'passwd',
Values => {username => $username,
uid => $uid,
gcos => $gcos,
...});
This method inserts a new entry into a database table. See _prepare_sql for the named parameters used.
$db->update (Table => 'passwd',
Values => {username => $new_username,
pwd => 'x',
uid => $uid,
...},
Where => "username='$old_username'");
This method updates an existing entry in a database table. See _prepare_sql for the named parameters used.
$db->delete (Table => 'users',
Where => "username='jowaxman'");
This method deletes an existing entry from a database table. See _prepare_sql for the named parameters used.
my @tables = $db->show_tables ();
This method returns an array containg the table names.
my $table_info = $db->describe (Table => 'users');
This method returns a reference to a hash containing information about fields.
Jonathan Waxman jowaxman@law.upenn.edu
Copyright (c) 2002 Jonathan A. Waxman All rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| DBIx-Wrap documentation | Contained in the DBIx-Wrap distribution. |
############################################################################### # DBIx::Wrap # # Copyright (c) 2002 Jonathan A. Waxman <jowaxman@bbl.med.upenn.edu> # All rights reserved. # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. ############################################################################### package DBIx::Wrap; use strict; use vars qw($VERSION); use DBI; use Time::Local; $VERSION = '1.00';
sub new { # Create myself. my $proto = shift; my $class = ref ($proto) || $proto; my $self = {}; bless ($self, $class); # Get params. my %params = @_; $self->{_sth} = {}; $self->{_dsn} = $params{DSN}; $self->{_user} = $params{User}; $self->{_dbh} = eval {DBI->connect ($self->{_dsn}, $self->{_user}, $params{Password}, {RaiseError => 0, PrintError => 0})}; return $proto->error ($@) if $@; return $proto->error ($DBIx::errstr) if ! defined $self->{_dbh}; return $self; }
sub error { my $self = shift; my $error = shift; # If an error given, set it in the object or package. # Otherwise, return the error from the object or package. if (defined $error) { ref ($self) ? $self->{_error} = $error : $self::_error = $error; return undef; } else { return ref ($self) ? $self->{_error} : $self::_error; } }
sub _prepare_sql { my $self = shift; my ($type, $params) = @_; my $table; if (exists $self->{_table}) { $table = $self->{_table}; } else { if (exists $params->{Table}) { $table = $params->{Table}; } elsif (exists $params->{Tables}) { $table = $params->{Tables}; } elsif ($type ne 'show') { return $self->error ("$type: No Table parameter given."); } } my $where = $params->{Where} if exists $params->{Where}; my $orderby = $params->{OrderBy} if exists $params->{OrderBy}; my $limit = $params->{Limit} if exists $params->{Limit}; my $match = $params->{Match} if exists $params->{Match}; my $sql; if ($type eq 'select') { my $fields; if (exists $params->{Fields}) { $fields = $params->{Fields}; } elsif (exists $params->{Field}) { $fields = $params->{Field}; } else { $fields = '*'; } if (defined $match) { $fields .= ',' if defined $fields; if (defined $params->{Round} && $params->{Round} eq 'yes') { $fields .= "ROUND(MATCH $match) AS _score"; } else { $fields .= "MATCH $match AS _score"; } $where .= ' and ' if defined $where; $where .= "MATCH $match"; } $sql = "SELECT $fields FROM $table"; $sql .= " WHERE $where" if defined $where; $sql .= " ORDER BY $orderby" if defined $orderby; $sql .= " LIMIT $limit" if defined $limit; } elsif ($type eq 'insert') { return $self->error ('insert: No Values parameter given.') if ! defined $params->{Values}; $sql = "INSERT INTO $table ("; my ($col_names, $values); foreach my $field (keys %{$params->{Values}}) { $col_names .= ',' if defined $col_names; $col_names .= $field; $values .= ',' if defined $values; if (exists $params->{Values}->{$field} && ! defined $params->{Values}->{$field}) { # If a CSV database, using null for an empty value will result in # absent colons so you must set an empty string value. if (exists $self->{_dbh}->{csv_tables}) { $values .= "''"; } else { $values .= 'null'; } } else { $params->{Values}->{$field} =~ s/'/''/g; # xxx if ($params->{Values}->{$field} =~ /FROM_UNIXTIME/ || $params->{Values}->{$field} =~ /NOW/) { $values .= "$params->{Values}->{$field}"; } else { $values .= "'$params->{Values}->{$field}'"; } } } $sql .= "$col_names) VALUES ($values)"; } elsif ($type eq 'update') { return $self->error ('insert: No Values parameter given.') if ! defined $params->{Values}; $sql = "UPDATE $table SET "; my ($col_names, $values); foreach my $field (keys %{$params->{Values}}) { $col_names .= ',' if defined $col_names; if (exists $params->{Values}->{$field} && ! defined $params->{Values}->{$field}) { # If a CSV database, using null for an empty value will result in # absent colons so you must set an empty string value. if (exists $self->{_dbh}->{csv_tables}) { $col_names .= "$field=''"; } else { $col_names .= "$field=null"; } } else { $params->{Values}->{$field} =~ s/'/''/g; $col_names .= "$field='$params->{Values}->{$field}'"; } } $sql .= $col_names; $sql .= " WHERE $where" if defined $where; } elsif ($type eq 'delete') { $sql = "DELETE FROM $table"; $sql .= " WHERE $where" if defined $where; } elsif ($type eq 'describe') { my $fields; if (exists $params->{Fields}) { $fields = $params->{Fields}; } elsif (exists $params->{Field}) { $fields = $params->{Field}; } else { $fields = '%'; } $sql = "DESCRIBE $table '$fields'"; } elsif ($type eq 'alter') { return $self->error ('alter: No Action parameter given.') if ! defined $params->{Action}; my $action = $params->{Action}; $sql = "ALTER TABLE $params->{Table} ";# . uc $action . " "; if ($action eq 'add') { my $columns = $params->{Columns} || $params->{Column}; if (defined $params->{PrimaryKey} && $params->{PrimaryKey}) { return $self->error ('alter [ADD PRIMARY KEY]: No Column[s] parameter given.') if ! defined $columns; $sql .= "ADD PRIMARY KEY $columns"; } elsif ((defined $params->{Unique} && $params->{Unique}) || (defined $params->{FullText} && $params->{FullText})) { my $add = $params->{Unique} ? 'UNIQUE' : 'FULLTEXT'; return $self->error ("alter [ADD $add]: No Column[s] parameter given.") if ! defined $columns; $sql .= "ADD $add"; $sql .= " $params->{Index}" if defined $params->{Index}; $sql .= " ($columns)"; # Index must come after Unique/Fulltext. } elsif (defined $params->{Index}) { return $self->error ('alter [ADD INDEX]: No Column[s] parameter given.') if ! defined $columns; $sql .= "ADD INDEX $params->{Index} ($columns)"; } elsif (defined $params->{Definition}) { return $self->error ('alter [ADD]: No Column parameter given.') if ! defined $params->{Column}; $sql .= "ADD $params->{Column} "; $sql .= $self->_prepare_definition ($params->{Definition}) || return $self->error ("alter [ADD]: " . $self->error ()); $sql .= " $params->{Position}" if defined $params->{Position}; } } elsif ($action eq 'alter') { return $self->error ('alter [ALTER]: No Column parameter given.') if ! defined $params->{Column}; return $self->error ('alter [ALTER]: No Default parameter given.') if ! exists $params->{Default}; $sql .= "ALTER $params->{Column}"; # xxx default needs to be a literal. $sql .= defined $params->{Default} ? " SET DEFAULT $params->{Default}" : ' DROP DEFAULT'; } elsif ($action eq 'change') { return $self->error ('alter [CHANGE]: No Column parameter given.') if ! defined $params->{Column}; return $self->error ('alter [CHANGE]: No Definition parameter given.') if ! defined $params->{Definition}; $params->{Definition}->{Column} = $params->{Column} if ! defined $params->{Definition}->{Column}; $sql .= "CHANGE $params->{Column} "; $sql .= $self->_prepare_definition ($params->{Definition}) || return $self->error ("alter [CHANGE]: " . $self->error ()); } elsif ($action eq 'modify') { return $self->error ('alter [MODIFY]: No Column parameter given.') if ! defined $params->{Column}; return $self->error ('alter [MODIFY]: No Definition parameter given.') if ! defined $params->{Definition}; $sql .= "MODIFY "; $sql .= $self->_prepare_definition ($params->{Definition}) || return $self->error ("alter [MODIFY]: " . $self->error ()); $sql .= " " . $params->{Position} if defined $params->{Position}; } elsif ($action eq 'drop') { if (defined $params->{PrimaryKey} && $params->{PrimaryKey}) { $sql .= "DROP PRIMARY KEY"; } elsif (defined $params->{Index}) { return $self->error ('alter [DROP INDEX]: No Index parameter given.') if ! defined $params->{Index}; $sql .= "DROP INDEX $params->{Index}"; } else { return $self->error ('alter [DROP]: No Column parameter given.') if ! defined $params->{Column}; $sql .= "DROP $params->{Column}"; } } elsif ($action eq 'disable_keys') { $sql .= "DISABLE KEYS"; } elsif ($action eq 'enable_keys') { $sql .= "ENABLE KEYS"; } elsif ($action eq 'rename') { return $self->error ('alter [RENAME]: No NewTable parameter given.') if ! defined $params->{NewTable}; $sql .= "RENAME $params->{NewTable}"; } elsif ($action eq 'orderby') { return $self->error ('alter [ORDER BY]: No Column parameter given.') if ! defined $params->{Column}; $sql .= "ORDER BY $params->{Column}"; } } elsif ($type eq 'show') { return $self->error ('show: No Action parameter given.') if ! defined $params->{Action}; my $action = $params->{Action}; $sql = "SHOW "; if ($action eq 'table_status') { $sql .= "TABLE STATUS"; $sql .= " LIKE '$table'" if defined $table; } } return $sql; } sub _prepare_definition { my $self = shift; my $params = shift; my $definition; return $self->error ('No Definition Type parameter given.') if ! defined $params->{Type}; return $self->error ('No Definition Length parameter given.') if $params->{Type} =~ /^(decimal)|(numeric)|(char)|(varchar)$/i && ! defined $params->{Length}; return $self->error ('No Definition Decimals parameter given.') if ($params->{Type} =~ /^(decimal)|(numeric)$/i || (defined $params->{Length} && $params->{Type} =~ /^(real)|(double)|(float)$/i)) && ! defined $params->{Decimals}; return $self->error ('No Definition Values parameter given.') if $params->{Type} =~ /^(set)|(enum)$/i && (! defined $params->{Values} || ! scalar @{$params->{Values}}); $definition .= "$params->{Column} " if defined $params->{Column}; $definition .= "$params->{Type}"; if (defined $params->{Length}) { $definition .= "($params->{Length}"; $definition .= ",$params->{Decimals}" if defined $params->{Decimals}; $definition .= ")"; } elsif (defined $params->{Values}) { $definition .= "('" . join ("','", @{$params->{Values}}) . "')"; } $definition .= " UNSIGNED" if defined $params->{Unsigned} && $params->{Unsigned}; $definition .= " ZEROFILL" if defined $params->{ZeroFill} && $params->{ZeroFill}; $definition .= " BINARY" if defined $params->{Binary} && $params->{Binary}; $definition .= " NOT NULL" if defined $params->{Null} && ! $params->{Null}; $definition .= " DEFAULT $params->{Default}" if defined $params->{Default}; $definition .= " AUTO_INCREMENT" if defined $params->{AutoIncrement} && $params->{AutoIncrement}; $definition .= " PRIMARY KEY" if defined $params->{PrimaryKey} && $params->{PrimaryKey}; return $definition; }
sub table { my $self = shift; my $table = shift; $self->{_table} = $table; }
sub select { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('select', \%params) || return undef; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; if (wantarray) { my @row = $sth->fetchrow; $sth->finish; return @row; } else { my $hashref = $sth->fetchrow_hashref; $sth->finish; return $hashref; } } sub selectall { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('select', \%params) || return undef; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; if (wantarray) { my @rows; while (my @row = $sth->fetchrow) { if (scalar (@row) == 1) { push (@rows, $row[0]); } else { push (@rows, \@row); } } $sth->finish; return @rows; } else { my @rows; while (my $row = $sth->fetchrow_hashref) { push (@rows, $row); } $sth->finish; return \@rows; } }
sub each { my $self = shift; my ($id, %params) = @_; my $sth; if (defined $$id) { $sth = $self->{_sth}->{$$id}; } else { my $sql = $self->_prepare_sql ('select', \%params) || return undef; $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("each: Could not execute: '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; $$id = scalar (keys %{$self->{_sth}}); $self->{_sth}->{$$id} = $sth; } if (wantarray) { my @row = $sth->fetchrow; if (! @row) { $sth->finish; delete $self->{_sth}->{$$id}; } return @row; } else { my $hashref = $sth->fetchrow_hashref; if (! $hashref) { $sth->finish; delete $self->{_sth}->{$$id}; } return $hashref; } }
sub iterator { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('select', \%params) || return undef; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; my $iterator = DBIx::Wrap::Iterator->new ($sth); return $iterator; }
sub insert { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('insert', \%params) || return undef; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; return 1; }
sub update { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('update', \%params) || return undef; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; return 1; }
sub delete { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('delete', \%params) || return undef; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; return 1; }
sub show_tables { my $self = shift; my $sth = $self->{_dbh}->prepare ('show tables'); $sth->execute || return $self->error ("Could not execute 'SHOW TABLES': " . $self->{_dbh}->errstr); $self->{_error} = undef; my @tables; while (my @row = $sth->fetchrow_array) { push (@tables, @row); } return (@tables); }
sub describe { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('describe', \%params) || return undef; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; my (%table_info, @table_info); while (my @row = $sth->fetchrow_array) { my %field_info = (); my $field = $row[0]; my $type = $row[1]; my $key = $row[3]; $field_info{field} = $field if wantarray; $field_info{key} = $key; # INT if ($type =~ /^int(\(([^)]*)\))?( unsigned)?( zerofill)?/i) { $field_info{type} = 'int'; $field_info{size} = $2 if defined $2 && $2 ne ''; $field_info{unsigned} = 1 if defined $3 && $3 ne ''; $field_info{zerofill} = 1 if defined $4 && $4 ne ''; # DATETIME } elsif ($type =~ /^datetime/) { $field_info{type} = 'datetime'; # CHAR } elsif ($type =~ /^(national )?char\(([^)]*)\)( binary)?/i) { $field_info{type} = 'char'; $field_info{national} = 1 if defined $1 && $1 ne ''; $field_info{size} = $2; $field_info{binary} = 1 if defined $3 && $3 ne ''; # VARCHAR } elsif ($type =~ /^(national )?varchar\(([^)]*)\)( binary)?/i) { $field_info{type} = 'varchar'; $field_info{national} = 1 if defined $1 && $1 ne ''; $field_info{size} = $2; $field_info{binary} = 1 if defined $3 && $3 ne ''; # BLOB, TEXT } elsif ($type =~ /^blob/i) { $field_info{type} = 'blob'; } elsif ($type =~ /^text/i) { $field_info{type} = 'text'; # MEDIUMBLOB, MEDIUMTEXT } elsif ($type =~ /^mediumblob/i) { $field_info{type} = 'mediumblob'; } elsif ($type =~ /^mediumtext/i) { $field_info{type} = 'mediumtext'; # ENUM } elsif ($type =~ /^enum\(\'([^)]*)\'\)/i) { $field_info{type} = 'enum'; my @values = split ("','", $1); $field_info{values} = \@values; } if (wantarray) { push (@table_info, \%field_info); } else { $table_info{$field} = \%field_info; } } if (wantarray) { return @table_info; } else { return \%table_info; } } sub alter { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('alter', \%params) || return undef; #print "$sql\n"; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; return 1; } sub show { my $self = shift; my %params = @_; my $sql = $self->_prepare_sql ('show', \%params) || return undef; my $sth = $self->{_dbh}->prepare ($sql); $sth->execute || return $self->error ("Could not execute '$sql': " . $self->{_dbh}->errstr); $self->{_error} = undef; my (%table_status, @table_status); while (my $row = $sth->fetchrow_hashref) { if (defined $params{Format}) { if ($params{Format} eq 'unix') { $row->{Update_time} = $self->date2secs ($row->{Update_time}); } } if (wantarray) { push (@table_status, $row); } else { $table_status{$row->{Name}} = $row; } } return wantarray ? @table_status : \%table_status; } sub date2secs { my $self = shift; my $date = shift; my ($year, $mon, $mday, $hour, $min, $sec, $secs); # Convert database date (0000-00-00 00:00). if ($date =~ /^(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)$/) { $year = $1; $mon = $2; $mon--; $mday = $3; $hour = $4; $min = $5; $sec = $6; $secs = timelocal ($sec, $min, $hour, $mday, $mon, $year - 1900); } return $secs; } sub DESTROY { my $self = shift; # Finish any unfinished statement handles from calls to each. foreach (keys %{$self->{_sth}}) { $self->{_sth}->{$_}->finish; } # Disconnect from the database. $self->{_dbh}->disconnect () if defined $self->{_dbh}; } package DBIx::Wrap::Iterator; sub new { # Create myself. my $proto = shift; my $class = ref ($proto) || $proto; my $self = {}; bless ($self, $class); $self->{_sth} = shift; return $self; } sub next { my $self = shift; if (wantarray) { my @row = $self->{_sth}->fetchrow; $self->{_sth}->finish if ! @row; return @row; } else { my $hashref = $self->{_sth}->fetchrow_hashref; $self->{_sth}->finish if ! $hashref; return $hashref; } } 1; __END__