File Coverage

blib/lib/DBO.pm

Criterion	Covered	Total	%
statement	121	154	78.5
branch	3	16	18.7
condition			n/a
subroutine	46	55	83.6
pod	6	15	40.0
total	176	240	73.3

#------------------------------------------------------------------------------
# DBO - Database Objects
#
# DESCRIPTION
#   An object-oriented database abstraction layer.
#
# AUTHOR
#   Gareth Rees
#
# COPYRIGHT
#   Copyright (c) 1999 Canon Research Centre Europe Ltd/
#
# $Id: DBO.pm,v 1.4 1999/06/29 17:09:30 garethr Exp $
#------------------------------------------------------------------------------

use strict;
package DBO;
use base 'Exporter';
use Carp;
use UNIVERSAL 'isa';
use Class::Multimethods qw(visit_database visit_table);
use vars qw($VERSION $DEBUG @EXPORT_OK %EXPORT_TAGS);

$VERSION = '0.01';
$DEBUG = 0;
@EXPORT_OK = qw(Database Table Key Option ForeignKey Char Text Integer Unsigned AutoIncrement Time);
%EXPORT_TAGS = (constructors => [qw(Database Table Key Option ForeignKey Char Text Integer Unsigned AutoIncrement Time)]);

sub new {
  my $class = shift;
  my $self = bless { @_ }, $class;

  # Check that the schema argument is a DBO::Database.
  isa($self->{schema},'DBO::Database')
    or croak(DBO::Exception->new
	     (SCHEMA => "'schema' must be a DBO::Database, not %s.",
	      ref $self->{schema}));

  # Check that the handle argument is a DBO::Handle.
  isa($self->{handle},'DBO::Handle')
    or croak(DBO::Exception->new
	     (HANDLE => "'handle' must be a DBO::Handle, not %s.",
	      ref $self->{handle}));

  # Apply the Initialize visitor.
  require DBO::Visitor::Initialize;
  $self->apply_to_database('DBO::Visitor::Initialize');

  return $self;
}

sub DESTROY {
  my $self = shift;
  $self->{dbh}->disconnect;
}

sub apply_to_database {
  my $self = shift;
  my $vis = shift;
  $vis = $vis->new(@_) unless ref $vis;
  visit_database($vis, $self->{schema}, $self->{handle});
}

sub apply_to_table {
  my $self = shift;
  my $id = shift;
  my $table = $self->{schema}->lookup_table($id)
    or die DBO::Exception->new(NO_SUCH_TABLE => "No such table: %s", $id);
  my $vis = shift;
  $vis = $vis->new(@_) unless ref $vis;
  visit_table($vis, $table, $self->{handle});
}

sub error {
  my $self = shift;
  $self->{error} = shift;
}

#------------------------------------------------------------------------------
# Constructor functions (for convenience)
#------------------------------------------------------------------------------

sub Database       { DBO::Database->new(@_) }
sub Table          { DBO::Table->new(@_) }
sub Key		   { DBO::Column::Key->new(@_) }
sub Option	   { DBO::Column::Option->new(@_) }
sub ForeignKey	   { DBO::Column::ForeignKey->new(@_) }
sub Char	   { DBO::Column::Char->new(@_) }
sub Text	   { DBO::Column::Text->new(@_) }
sub Integer	   { DBO::Column::Integer->new(@_) }
sub Unsigned	   { DBO::Column::Unsigned->new(@_) }
sub AutoIncrement  { DBO::Column::AutoIncrement->new(@_) }
sub Time	   { DBO::Column::Time->new(@_) }


#------------------------------------------------------------------------------
# DBO::Handle - handle to a database
#------------------------------------------------------------------------------

package DBO::Handle;

package DBO::Handle::DBI;
use base 'DBO::Handle';
use vars '$AUTOLOAD';

sub connect {
  my $class = shift;
  require DBI;
  my $dbh = DBI->connect(@_) or return;
  bless \$dbh, $class;
}

sub dosql {
  my $self = shift;
  my $sql = join ' ', @_;
  $$self->do($sql)
    or croak(DBO::Exception->new
	     (SQL => "Failed to execute SQL statement %s: %s.",
	      $sql, $$self->errstr));
}

sub AUTOLOAD {
  my $self = shift;
  my $method = $AUTOLOAD;
  $method =~ s/.*://;
  $$self->$method(@_);
}

package DBO::Handle::DBI::mSQL;
use base 'DBO::Handle::DBI';

package DBO::Handle::DBI::mysql;
use base 'DBO::Handle::DBI';


#------------------------------------------------------------------------------
# DBO::Exception - class of exceptions
#------------------------------------------------------------------------------

package DBO::Exception;

sub new {
  my $class = shift;
  my $exception = shift;
  my $default = shift;
  my $self = bless { exception => $exception,
		     default => $default,
		     args => [ @_ ] }, $class;
  warn $self->format if $DBO::DEBUG;
  return $self;
}

sub format {
  my $self = shift;
  sprintf $self->{default}, @{$self->{args}};
}


#------------------------------------------------------------------------------
# DBO::Database - abstract representation of a database
#------------------------------------------------------------------------------

package DBO::Database;
use Class::Multimethods 'visit_database';

sub new {
  my $class = shift;
  my $self = bless { @_ }, $class;
  return $self;
}

sub lookup_table {
  my $self = shift;
  my $id = shift;
  $self->{tables_by_id}{$id};
}


#------------------------------------------------------------------------------
# DBO::Table - abstract representation of a database table
#------------------------------------------------------------------------------

package DBO::Table;
use Class::Multimethods 'visit_table';

sub new {
  my $class = shift;
  my $self = bless { @_ }, $class;
  return $self;
}

sub lookup_column {
  my $self = shift;
  my $id = shift;
  $self->{columns_by_id}{$id};
}


#------------------------------------------------------------------------------
# DBO::Column - abstract representation of a database column
#------------------------------------------------------------------------------

package DBO::Column;
use Class::Multimethods 'visit_column';

sub new {
  my $class = shift;
  my $self = bless { @_ }, $class;
  return $self;
}

sub visit {
  my $self = shift;
  my $visitor = shift;
  visit_column($visitor, $self);
}

package DBO::Column::Modifier;
use base 'DBO::Column';

package DBO::Column::Key;
use base 'DBO::Column::Modifier';

package DBO::Column::Option;
use base 'DBO::Column::Modifier';

package DBO::Column::ForeignKey;
use base 'DBO::Column::Modifier';

package DBO::Column::Base;
use base 'DBO::Column';

package DBO::Column::Number;
use base 'DBO::Column::Base';

package DBO::Column::String;
use base 'DBO::Column::Base';

package DBO::Column::Char;
use base 'DBO::Column::String';

package DBO::Column::Text;
use base 'DBO::Column::String';

package DBO::Column::Integer;
use base 'DBO::Column::Number';

package DBO::Column::Unsigned;
use base 'DBO::Column::Integer';

package DBO::Column::AutoIncrement;
use base 'DBO::Column::Unsigned';

package DBO::Column::Time;
use base 'DBO::Column::Char';


#------------------------------------------------------------------------------
# DBO::Visitor - an action on a database
#------------------------------------------------------------------------------

package DBO::Visitor;
use Class::Multimethods;

sub new {
  my $class = shift;
  my $self = bless { @_ }, $class;
  return $self;
}

multimethod visit_database =>
  qw(DBO::Visitor DBO::Database DBO::Handle) =>
sub {
  my ($vis, $database, $handle) = @_;
  foreach my $table (@{$database->{tables}}) {
    visit_table($vis, $table, $handle);
  }
};

multimethod visit_table =>
  qw(DBO::Visitor DBO::Table DBO::Handle) =>
sub {
  my ($vis, $table, $handle) = @_;
  foreach my $col (@{$table->{columns}}) {
    visit_column($vis, $col, $handle);
  }
};

multimethod visit_column =>
  qw(DBO::Visitor DBO::Column::Base DBO::Handle) =>
sub {
  # my ($vis, $col, $handle) = @_;
};

multimethod visit_column =>
  qw(DBO::Visitor DBO::Column::Modifier DBO::Handle) =>
sub {
  my ($vis, $col, $handle) = @_;
  visit_column($vis, $col->{base}, $handle);
};

1;

__END__