Alzabo
view release on metacpan or search on metacpan
- The changes introduced in 0.71 to track table and column renames
could cause bogus SQL to be generated if something was renamed, the
schema was instantiated, and then the schema was compared to an
existing live database which also had the same renaming done to it.
- If you tried to create a relationship between two tables where one
of the tables had a varchar or char column as part of its PK, and
you let Alzabo create the foreign key column in the other table,
then Alzabo would try to set the length of the varchar/char column
to undef, which would cause an exception to be thrown.
---------------------------------------------------------------------------
0.82 January 6, 2004
ENHANCEMENTS:
- The Alzabo::Runtime::Table->insert() and
Alzabo::Runtime::InsertHandle->insert() methods will not create a
new row object when called in void context. This should make
"table_to" table already had a column of the same name as the
"column_from" column, then Alzabo died with an error. Reported by
Ping Liang.
- If you had previously installed Alzabo, and then provided a new
Alzabo root directory or a new directory for the Mason components,
this was not respected during the installation process.
- Alzabo's referential integrity checks will no longer complain if you
attempt to set a foreign key column to NULL. Previously it would
throw an exception if the column was part of the dependent table in
a foreign key relationship. Now, it just assumes you really meant
to allow the column to be NULLable.
- The schema class's load_from_file() method now blesses the loaded
schema into the calling class. So if you use MethodMaker to
generate classes, and then call My::Schema->load_from_file, it
should always return an object blessed into the My::Schema class.
Reported by Ken Williams.
- When checking for the MySQL variable sql_mode, the value may be
- Alzabo::DriverStatement->next_hash method has been renamed
next_as_hash.
---------------------------------------------------------------------------
0.70 November 21, 2002
ENHANCEMENTS:
- The exception thrown when you attempt to set a non-nullable column
to NULL is now an Alzabo::Exception::NotNullable exception, instead
of an Alzabo::Exception::Params exception. In the interests of
backwards compatibility, the former is a subclass of the latter.
- Improved debugging options. See the new Alzabo::Debug module for
details.
BUG FIXES:
- Fixed Alzabo::Table->primary_key, which would die when no primary
- Added documentation to all the components in mason/widgets. You can
run perldoc on those files for more details.
- Added a very ugly hack to work around a bug with Storable 2.00 -
2.03 and a Perl < 5.8.0.
- It is now possible to install Alzabo without defining an Alzabo root
directory. This means you will have to set this by calling
Alzabo::Config::root_dir() every time you load Alzabo. An attempt
to load a schema without first defining the root_dir will throw an
exception. Based on a patch from Ilya Martynov.
BUG FIXES:
- Allow UNIQUE as a column attribute for Postgres. Reported by Dan
Martinez.
- Add DISTINCT back as an exportable function from the SQLMaker
subclasses. It may be useful when calling ->select and ->function.
- The parent and children methods created by Alzabo::MethodMaker were
incorrect (and unfortunately the tests of this feature were hosed
too).
- Add YEAR as exportable function from Alzabo::SQLMaker::MySQL.
- Fix definition of WEEK and YEARWEEK functions exported from
Alzabo::SQLMaker::MySQL to accept 1 or 2 parameters.
- A bug in the caching code was throwing an exception when attempting
to update objects that weren't expired. This only seemed to occur
in conjuction with the prefetch functionality. The caching code has
been simplified a bit and is hopefully now bug-free (I can dream,
can't I?).
- Make it possible to call Alzabo::Runtime::Schema->join with only one
table in the tables parameter. This is useful if you are
constructing your join at runtime and you don't know how many tables
you'll end up with.
Patch by Ilya Martynov.
- Make Alzabo::Schema->run_in_transaction preserve scalar/array
context and return whatever was returned by the wrapped code.
BUG FIXES:
- Did some review and cleanup of the exception handling code. There
were some places where exceptions were being handled in an unsafe
manner as well as some spots where exception objects should have
been thrown that were just using die.
- Ignore failure to rollback for MySQL when not using transactional
table.
- Alzabo was not handling the BETWEEN operator in where clauses
properly. Patch by Eric Hillman.
- Passing in something like this to rows_where:
( where => [ $col_foo, '=', 1,
- The 'dbm_file' parameter given when loading a syncing module that
used DBM files (such as Alzabo::ObjectCache::Sync::SDBM_File) has
been changed to 'sync_dbm_file', because this release includes a new
cache storage module that uses DBM files as well.
- The schema creator now requires HTTP::BrowserDetect.
- Fix what was arguably a bug in the caching/syncing code.
Previously, one process could update a row and another process could
then update that same row. Now the second process will throw an
exception.
BUG FIXES:
- Accidentally left debugging turned on in Alzabo::Exceptions.
- The schema creator did not allow you to remove a length or precision
setting for a column once it had been made.
- Require a length for CHAR and VARCHAR columns with MySQL.
- Rules violations error messages (bad table name, for example) in the
schema creator are now handled in a much friendlier manner. Instead
of the big error dump exception page it returns you to the page you
submitted from with an error message.
- Add Alzabo::Create::Column->alter method which allows you to change
the column type, length, and precision all at once. This is
necessary because some of the column type validation code will
insist that a column have a length setting. If you try to change
them in two separate operations it will throw an exception.
- Add Alzabo::ObjectCache::Store::Null - This allows you to use any
multi-process syncing module without using up the memory that
Alzabo::ObjectCache::Store::Memory uses.
- Add Alzabo::ObjectCache::Store::BerkeleyDB - I'm not sure if storing
in a db file is really a performance win (vs. null storage) because
of the work needed to freeze & thaw the row objects. Benchmarks are
needed.
new version of Alzabo.
- Many improvements and updates to Alzabo::MethodMaker. Highlights
include fixing a bug that prevented the insert and update methods
from being created, a new callback system that allows you to specify
all the method names to be generated, and a new 'self_relations'
option for tables that have parent/child relationships with
themself.
- Fix handling of NULL columns for inserts and updates. Now, Alzabo
only throws an exception if the column is not nullable and has no
default. If it has a default and is specified as NULL then it will
not be included in the INSERT clause (in which case the RDBMS should
insert the default value itself).
- Fix bugs in Postgres reverse engineering. Defaults were not handled
properly, nor were numeric column type length and precision.
- The schema creator and data browser now allow you to enter the host
for database connections where needed.
- Alzabo::Runtime::Table->row_count can now take a where clause.
- Fix bugs in Alzabo::Create::Table. This was causing problems with
indexes when the table name was changed.
- Fixed a bug in Alzabo::Util that caused the test cases to fail if
Alzabo hadn't been previously installed. Reported by Robert Goff.
- The SQLMaker class is now smarter about not letting you make bad
SQL. For example, if you try to make a WHERE clause with tables not
mentioned in the FROM clause, it will throw an exception. This will
hopefully help catch logic errors in your code a bit sooner.
- Removed use of prepare_cached in Alzabo::Driver. This has the
potential to cause some strange errors under Alzabo. Because of the
way Alzabo works, it is possible to have a Cursor object holding
onto a statement handle that needs to be used elsewhere (by a row
object, for example). It is safer to let a new statement handle be
created in this case.
INCOMPATIBILITIES
However, the new DBMSync module will probably scale better, and
performance should be about the same for smaller applications. To
use it, do:
use Alzabo::ObjectCache( store => 'Alzabo::ObjectCache::MemoryStore',
sync => 'Alzabo::ObjectCache::DBMSync' );
4. If you run without any caching at all then the
Alzabo::Runtime::Row class's behavior has changed somewhat. In
particular, selects or updates against a deleted object will always
throw an Alzabo::Exception::NoSuchRow exception. Before, the
behavior wasn't very well defined.
Please read the section on clearing the cache in the
Alzabo::ObjectCache module, as this is an important concept. By
default, the caching and syncing modules will just grow unchecked.
You need to clear at the appropriate points (usually your
application's entry points) in order to keep them under control.
---------------------------------------------------------------------------
inc/Alzabo/Config.pm.tmpl view on Meta::CPAN
my $updir = File::Spec->updir;
sub root_dir
{
$CONFIG{root_dir} = $_[0] if defined $_[0];
return $CONFIG{root_dir};
}
sub schema_dir
{
Alzabo::Exception->throw( error => "No Alzabo root directory defined" )
unless defined $CONFIG{root_dir};
return File::Spec->catdir( $CONFIG{root_dir}, 'schemas' );
}
sub available_schemas
{
my $dirname = Alzabo::Config::schema_dir;
local *DIR;
opendir DIR, $dirname
or Alzabo::Exception::System->throw( error => "can't open $dirname: $!\n" );
my @s;
foreach my $e (readdir DIR)
{
next if $e eq $curdir || $e eq $updir;
my $dir = File::Spec->catdir( $dirname, $e );
push @s, $e
if -d $dir && -r _ && glob "$dir/*.alz";
}
closedir DIR
or Alzabo::Exception::System->throw( error => "can't close $dirname: $!\n" );
return @s;
}
__END__
=head1 NAME
Alzabo::Config - Alzabo configuration information
inc/Alzabo/Config.pm.tmpl view on Meta::CPAN
If a value is passed to this method then the root is temporarily
changed. This change lasts as long as your application remains in
memory. However, since changes are not written to disk it will have
to be changed again.
Returns the root directory for your Alzabo installation.
=head2 schema_dir
If no root_dir is defined, this function throws an exception.
Returns the directory under which Alzabo schema objects are stored in
serialized form.
=head2 available_schemas
If no root_dir is defined, this function throws an exception.
Returns a list containing the names of the available schemas. There
will be one directory for each schema under the directory returned.
Directories which cannot be read will not be included in the list.
Throws: L<C<Alzabo::Exception::System>|Alzabo::Exceptions>
=cut
lib/Alzabo/BackCompat.pm view on Meta::CPAN
use Alzabo::Config;
use File::Basename;
use File::Copy;
use File::Spec;
use Storable;
use Tie::IxHash;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
use vars qw($VERSION);
$VERSION = 2.0;
#
# Each pair represents a range of versions which are compatible with
# each other. The first one is not quite right but it has to start
# somewhere ;)
#
lib/Alzabo/BackCompat.pm view on Meta::CPAN
glob("$dir/*.rdbms"),
glob("$dir/*.version") )
{
my $backup = "$file.bak.v$p{version}";
copy($file, $backup);
}
my $fh = do { local *FH; *FH };
open $fh, "<$c_file"
or Alzabo::Exception::System->throw( error => "Unable to open $c_file: $!" );
my $raw = Storable::fd_retrieve($fh)
or Alzabo::Exception::System->throw( error => "Can't read filehandle" );
close $fh
or Alzabo::Exception::System->throw( error => "Unable to close $c_file: $!" );
foreach (@cb)
{
$_->($raw);
$_->( $raw->{original} ) if $raw->{original};
}
open $fh, ">$c_file"
or Alzabo::Exception::System->throw( error => "Unable to write to $c_file: $!" );
Storable::nstore_fd( $raw, $fh )
or Alzabo::Exception::System->throw( error => "Can't store to filehandle" );
close $fh
or Alzabo::Exception::System->throw( error => "Unable to close $c_file: $!" );
my $version_file =
File::Spec->catfile( Alzabo::Config::schema_dir(),
$p{name}, "$p{name}.version" );
open $fh, ">$version_file"
or Alzabo::Exception::System->throw( error => "Unable to write to $version_file: $!" );
print $fh $Alzabo::VERSION
or Alzabo::Exception::System->throw( error => "Can't write to $version_file: $!" );
close $fh
or Alzabo::Exception::System->throw( error => "Unable to close $version_file: $!" );
Alzabo::Create::Schema->load_from_file( name => $p{name} )->save_to_file;
if ($create_loaded)
{
warn <<"EOF"
Your schema, $p{name}, has been updated to be compatible with the
installed version of Alzabo. This required that the Alzabo::Create::*
classes be loaded. If you were loading an Alzabo::Runtime::Schema
lib/Alzabo/ChangeTracker.pm view on Meta::CPAN
package Alzabo::ChangeTracker;
use strict;
use vars qw( $VERSION $STACK @CHANGES );
$VERSION = 2.0;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
1;
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
++$STACK;
lib/Alzabo/Column.pm view on Meta::CPAN
package Alzabo::Column;
use strict;
use vars qw($VERSION);
use Alzabo;
use Tie::IxHash;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = 2.0;
1;
sub table
{
$_[0]->{table};
}
lib/Alzabo/Create/Column.pm view on Meta::CPAN
$self->{name} = $name;
eval
{
$self->table->schema->rules->validate_column_name($self);
};
if ($@)
{
$self->{name} = $old_name;
rethrow_exception($@);
}
$self->table->register_column_name_change( column => $self,
old_name => $old_name )
if $old_name;
}
sub set_nullable
{
my $self = shift;
lib/Alzabo/Create/ColumnDefinition.pm view on Meta::CPAN
$self->owner->table->schema->rules->validate_primary_key($self->owner)
if $self->owner->is_primary_key;
$self->owner->table->schema->rules->validate_column_length($self->owner);
};
if ($@)
{
$self->{type} = $old_type;
$self->{length} = $old_length;
$self->{precision} = $old_precision;
rethrow_exception($@);
}
}
sub set_type
{
my $self = shift;
validate_pos( @_, { type => SCALAR } );
my $type = shift;
lib/Alzabo/Create/ColumnDefinition.pm view on Meta::CPAN
$self->{type} =
$self->owner->table->schema->rules->validate_column_type($type, $self->owner->table);
$self->owner->table->schema->rules->validate_primary_key($self->owner)
if eval { $self->owner->is_primary_key };
# eval ^^ cause if we're creating the column its not in the table yet
};
if ($@)
{
$self->{type} = $old_type;
rethrow_exception($@);
}
}
sub set_length
{
my $self = shift;
validate( @_, { length => { type => UNDEF | SCALAR },
precision => { type => UNDEF | SCALAR,
optional => 1 } } );
lib/Alzabo/Create/ColumnDefinition.pm view on Meta::CPAN
eval
{
$self->owner->table->schema->rules->validate_column_length($self->owner);
};
if ($@)
{
$self->{length} = $old_length;
$self->{precision} = $old_precision;
rethrow_exception($@);
}
}
1;
__END__
=head1 NAME
Alzabo::Create::ColumnDefinition - Column definition object for schema
lib/Alzabo/Create/Index.pm view on Meta::CPAN
if $self->{columns}->EXISTS($new_name);
$self->{columns}->STORE( $new_name, \%p );
eval { $self->table->schema->rules->validate_index($self); };
if ($@)
{
$self->{columns}->DELETE($new_name);
rethrow_exception($@);
}
}
sub delete_column
{
my $self = shift;
validate_pos( @_, { isa => 'Alzabo::Create::Column' } );
my $c = shift;
lib/Alzabo/Create/Index.pm view on Meta::CPAN
{
if ($old_val)
{
$col->{prefix} = $old_val;
}
else
{
delete $col->{prefix};
}
rethrow_exception($@);
}
}
sub set_unique
{
my $self = shift;
validate_pos( @_, 1 );
$self->{unique} = shift;
}
lib/Alzabo/Create/Index.pm view on Meta::CPAN
my $old_val = $self->{fulltext};
$self->{fulltext} = shift;
eval { $self->table->schema->rules->validate_index($self); };
if ($@)
{
$self->{fulltext} = $old_val;
rethrow_exception($@);
}
}
sub register_column_name_change
{
my $self = shift;
validate( @_, { column => { isa => 'Alzabo::Create::Column' },
old_name => { type => SCALAR } } );
my %p = @_;
lib/Alzabo/Create/Schema.pm view on Meta::CPAN
return if defined $self->{name} && $name eq $self->{name};
my $old_name = $self->{name};
$self->{name} = $name;
eval { $self->rules->validate_schema_name($self); };
if ($@)
{
$self->{name} = $old_name;
rethrow_exception($@);
}
# Gotta clean up old files or we have a mess!
$self->delete( name => $old_name ) if $old_name;
$self->set_instantiated(0);
undef $self->{original};
}
sub set_instantiated
{
lib/Alzabo/Create/Schema.pm view on Meta::CPAN
cardinality => $p{cardinality},
from_is_dependent => $p{from_is_dependent},
to_is_dependent => $p{to_is_dependent},
comment => $p{comment},
);
};
if ($@)
{
$tracker->backout;
rethrow_exception($@);
}
my @fk;
eval
{
foreach my $c ( @$col_from )
{
push @fk, $f_table->foreign_keys( table => $t_table,
column => $c );
}
};
if ($@)
{
$tracker->backout;
rethrow_exception($@);
}
$tracker->add( sub { $f_table->delete_foreign_key($_) foreach @fk } );
# cardinality to -> to
my $inverse_cardinality =
( $p{cardinality}->[1] eq '1' && $p{cardinality}->[0] eq '1' ?
'1_to_1' :
$p{cardinality}->[1] eq '1' && $p{cardinality}->[0] eq 'n' ?
'1_to_n' :
lib/Alzabo/Create/Schema.pm view on Meta::CPAN
cardinality => [ @{ $p{cardinality} }[1,0] ],
from_is_dependent => $p{to_is_dependent},
to_is_dependent => $p{from_is_dependent},
comment => $p{comment},
);
};
if ($@)
{
$tracker->backout;
rethrow_exception($@);
}
}
# old name - deprecated
*add_relation = \&add_relationship;
sub _check_add_relationship_args
{
my $self = shift;
my %p = @_;
lib/Alzabo/Create/Schema.pm view on Meta::CPAN
from_is_dependent => $p{to_is_dependent},
to_is_dependent => 1,
comment => $p{comment},
);
};
if ($@)
{
$tracker->backout;
rethrow_exception($@);
}
}
sub instantiated
{
my $self = shift;
return $self->{instantiated};
}
lib/Alzabo/Create/Table.pm view on Meta::CPAN
{
$self->schema->rules->validate_table_name($self);
};
$self->add_index($_) foreach @i;
if ($@)
{
$self->{name} = $old_name;
rethrow_exception($@);
}
if ( $old_name && eval { $self->schema->table($old_name) } )
{
$self->schema->register_table_name_change( table => $self,
old_name => $old_name );
foreach my $fk ($self->all_foreign_keys)
{
$fk->table_to->register_table_name_change( table => $self,
lib/Alzabo/Driver.pm view on Meta::CPAN
package Alzabo::Driver;
use strict;
use vars qw($VERSION);
use Alzabo::Exceptions;
use Class::Factory::Util;
use DBI;
use Params::Validate qw( validate validate_pos UNDEF SCALAR ARRAYREF );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = 2.0;
1;
sub new
{
shift;
my %p = @_;
eval "use Alzabo::Driver::$p{rdbms}";
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
my $self = "Alzabo::Driver::$p{rdbms}"->new(@_);
$self->{schema} = $p{schema};
return $self;
}
sub available { __PACKAGE__->subclasses }
sub _ensure_valid_dbh
{
my $self = shift;
unless ( $self->{dbh} )
{
my $sub = (caller(1))[3];
Alzabo::Exception::Driver->throw( error => "Cannot call $sub before calling connect." );
}
$self->{dbh} = $self->_dbi_connect( $self->{connect_params} )
if $$ != $self->{connect_pid};
}
sub quote
{
my $self = shift;
lib/Alzabo/Driver.pm view on Meta::CPAN
my @row;
$sth->bind_columns( \ (@row[ 0..$#{ $sth->{NAME_lc} } ] ) );
push @data, [@row] while $sth->fetch;
$sth->finish;
};
if ($@)
{
my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
Alzabo::Exception::Driver->throw( error => $@,
sql => $p{sql},
bind => \@bind );
}
return wantarray ? @data : $data[0];
}
sub rows_hashref
{
my $self = shift;
lib/Alzabo/Driver.pm view on Meta::CPAN
my %hash;
$sth->bind_columns( \ ( @hash{ @{ $sth->{NAME_uc} } } ) );
push @data, {%hash} while $sth->fetch;
$sth->finish;
};
if ($@)
{
my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
Alzabo::Exception::Driver->throw( error => $@,
sql => $p{sql},
bind => \@bind );
}
return @data;
}
sub one_row
{
my $self = shift;
lib/Alzabo/Driver.pm view on Meta::CPAN
my @row;
eval
{
@row = $sth->fetchrow_array;
$sth->finish;
};
if ($@)
{
my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
Alzabo::Exception::Driver->throw( error => $@,
sql => $p{sql},
bind => \@bind );
}
return wantarray ? @row : $row[0];
}
sub one_row_hash
{
my $self = shift;
lib/Alzabo/Driver.pm view on Meta::CPAN
my %hash;
eval
{
my @row = $sth->fetchrow_array;
@hash{ @{ $sth->{NAME_uc} } } = @row if @row;
$sth->finish;
};
if ($@)
{
my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
Alzabo::Exception::Driver->throw( error => $@,
sql => $p{sql},
bind => \@bind );
}
return %hash;
}
sub column
{
my $self = shift;
lib/Alzabo/Driver.pm view on Meta::CPAN
eval
{
my @row;
$sth->bind_columns( \ (@row[ 0..$#{ $sth->{NAME_lc} } ] ) );
push @data, $row[0] while ($sth->fetch);
$sth->finish;
};
if ($@)
{
my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
Alzabo::Exception::Driver->throw( error => $@,
sql => $p{sql},
bind => \@bind );
}
return wantarray ? @data : $data[0];
}
use constant _PREPARE_AND_EXECUTE_SPEC => { sql => { type => SCALAR },
bind => { type => UNDEF | SCALAR | ARRAYREF,
optional => 1 },
};
sub _prepare_and_execute
{
my $self = shift;
validate( @_, _PREPARE_AND_EXECUTE_SPEC );
my %p = @_;
Alzabo::Exception::Driver->throw( error => "Attempt to access the database without database handle. Was ->connect called?" )
unless $self->{dbh};
my @bind = exists $p{bind} ? ( ref $p{bind} ? @{ $p{bind} } : $p{bind} ) : ();
my $sth;
eval
{
$sth = $self->{dbh}->prepare( $p{sql} );
$sth->execute(@bind);
};
if ($@)
{
Alzabo::Exception::Driver->throw( error => $@,
sql => $p{sql},
bind => \@bind );
}
return $sth;
}
sub do
{
my $self = shift;
lib/Alzabo/Driver.pm view on Meta::CPAN
my $rows;
eval
{
$rows = $sth->rows;
$sth->finish;
};
if ($@)
{
my @bind = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [$p{bind}] ) : ();
Alzabo::Exception::Driver->throw( error => $@,
sql => $p{sql},
bind => \@bind );
}
return $rows;
}
sub tables
{
my $self = shift;
$self->_ensure_valid_dbh;
my @t = eval { $self->{dbh}->tables( '', '', '%', 'table' ); };
Alzabo::Exception::Driver->throw( error => $@ ) if $@;
return @t;
}
sub schemas
{
my $self = shift;
shift()->_virtual;
}
lib/Alzabo/Driver.pm view on Meta::CPAN
return $self->_dbi_connect( $self->_connect_params(@_) );
}
sub _dbi_connect
{
my $self = shift;
my $connect = shift;
my $dbh = eval { DBI->connect(@$connect) };
Alzabo::Exception::Driver->throw( error => $@ ) if $@;
Alzabo::Exception::Driver->throw( error => "Unable to connect to database\n" ) unless $dbh;
$self->{connect_params} = $connect;
$self->{connect_pid} = $$;
return $dbh;
}
sub statement
{
my $self = shift;
lib/Alzabo/Driver.pm view on Meta::CPAN
{
@r = $self->{dbh}->func(@_);
return @r;
}
else
{
$r[0] = $self->{dbh}->func(@_);
return $r[0];
}
};
Alzabo::Exception::Driver->throw( error => $self->{dbh}->errstr )
if $self->{dbh}->errstr;
}
sub DESTROY
{
my $self = shift;
$self->disconnect;
}
sub disconnect
lib/Alzabo/Driver.pm view on Meta::CPAN
sub rollback
{
my $self = shift;
$self->_ensure_valid_dbh;
$self->{tran_count} = undef;
eval { $self->{dbh}->rollback unless $self->{dbh}->{AutoCommit} };
Alzabo::Exception::Driver->throw( error => $@ ) if $@;
$self->{dbh}->{AutoCommit} = 1;
}
sub commit
{
my $self = shift;
$self->_ensure_valid_dbh;
lib/Alzabo/Driver.pm view on Meta::CPAN
sub driver_id
{
shift()->_virtual;
}
sub _virtual
{
my $self = shift;
my $sub = (caller(1))[3];
Alzabo::Exception::VirtualMethod->throw( error =>
"$sub is a virtual method and must be subclassed in " . ref $self );
}
package Alzabo::DriverStatement;
use strict;
use vars qw($VERSION);
use Alzabo::Exceptions;
use DBI;
use Params::Validate qw( validate UNDEF SCALAR ARRAYREF );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = '0.1';
sub new
{
my $self = shift->new_no_execute(@_);
$self->execute;
return $self;
lib/Alzabo/Driver.pm view on Meta::CPAN
$self->{offset} = $p{limit} && $p{limit}[1] ? $p{limit}[1] : 0;
$self->{rows_fetched} = 0;
eval
{
$self->{sth} = $p{dbh}->prepare( $p{sql} );
$self->{bind} = exists $p{bind} ? ( ref $p{bind} ? $p{bind} : [ $p{bind} ] ) : [];
};
Alzabo::Exception::Driver->throw( error => $@,
sql => $p{sql},
bind => $self->{bind} ) if $@;
return $self;
}
sub execute
{
my $self = shift;
lib/Alzabo/Driver.pm view on Meta::CPAN
$self->{sth}->finish if $self->{sth}->{Active};
$self->{rows_fetched} = 0;
$self->{sth}->execute( @_ ? @_ : @{ $self->{bind} } );
$self->{result} = [];
$self->{count} = 0;
$self->{sth}->bind_columns
( \ ( @{ $self->{result} }[ 0..$#{ $self->{sth}->{NAME_lc} } ] ) );
};
Alzabo::Exception::Driver->throw( error => $@,
sql => $self->{sth}{Statement},
bind => $self->{bind} ) if $@;
}
sub execute_no_result
{
my $self = shift;
eval
{
$self->{sth}->execute(@_);
};
Alzabo::Exception::Driver->throw( error => $@,
sql => $self->{sth}{Statement},
bind => $self->{bind} ) if $@;
}
sub next
{
my $self = shift;
my %p = @_;
return unless $self->{sth}->{Active};
my $active;
eval
{
do
{
$active = $self->{sth}->fetch;
} while ( $active && $self->{rows_fetched}++ < $self->{offset} );
};
Alzabo::Exception::Driver->throw( error => $@,
sql => $self->{sth}{Statement},
bind => $self->{bind} ) if $@;
return unless $active;
$self->{count}++;
return wantarray ? @{ $self->{result} } : $self->{result}[0];
}
lib/Alzabo/Driver.pm view on Meta::CPAN
return unless $self->{sth}->{Active};
my $active;
eval
{
do
{
$active = $self->{sth}->fetch;
} while ( $active && $self->{rows_fetched}++ < $self->{offset} );
};
Alzabo::Exception::Driver->throw( error => $@,
sql => $self->{sth}{Statement},
bind => $self->{bind} ) if $@;
return unless $active;
my %hash;
@hash{ @{ $self->{sth}->{NAME_lc} } } = @{ $self->{result} };
$self->{count}++;
lib/Alzabo/Driver.pm view on Meta::CPAN
}
sub count { $_[0]->{count} }
sub DESTROY
{
my $self = shift;
local $@;
eval { $self->{sth}->finish if $self->{sth}; };
Alzabo::Exception::Driver->throw( error => $@ ) if $@;
}
1;
__END__
=head1 NAME
Alzabo::Driver - Alzabo base class for RDBMS drivers
lib/Alzabo/Driver.pm view on Meta::CPAN
my $driver = Alzabo::Driver->new( rdbms => 'MySQL',
schema => $schema );
=head1 DESCRIPTION
This is the base class for all Alzabo::Driver modules. To instantiate
a driver call this class's C<new()> method. See L<SUBCLASSING
Alzabo::Driver> for information on how to make a driver for the RDBMS
of your choice.
This class throws several, exceptions, one of which,
C<Alzabo::Exception::Driver>, has additional methods not present in
other exception classes. See L<Alzabo::Exception::Driver METHODS> for
a description of these methods.
=head1 METHODS
=head2 available
Returns a list of names representing the available C<Alzabo::Driver>
subclasses. Any one of these names would be appropriate as the
lib/Alzabo/Driver/MySQL.pm view on Meta::CPAN
use strict;
use vars qw($VERSION);
use Alzabo::Driver;
use Alzabo::Utils;
use DBD::mysql;
use DBI;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = 2.0;
use base qw(Alzabo::Driver);
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
lib/Alzabo/Driver/MySQL.pm view on Meta::CPAN
sub schemas
{
my $self = shift;
my $dbh = $self->_make_dbh( name => '',
@_ );
my @schemas = $dbh->func('_ListDBs');
Alzabo::Exception::Driver->throw( error => $dbh->errstr )
if $dbh->errstr;
return @schemas;
}
sub create_database
{
my $self = shift;
my $db = $self->{schema}->db_schema_name;
my $dbh = $self->_make_dbh( name => '',
@_ );
$dbh->func( 'createdb', $db, 'admin' );
Alzabo::Exception::Driver->throw( error => $dbh->errstr )
if $dbh->errstr;
$dbh->disconnect;
}
sub drop_database
{
my $self = shift;
my $db = $self->{schema}->db_schema_name;
my $dbh = $self->_make_dbh( name => '',
@_ );
$dbh->func( 'dropdb', $db, 'admin' );
Alzabo::Exception::Driver->throw( error => $dbh->errstr )
if $dbh->errstr;
$dbh->disconnect;
}
sub _connect_params
{
my $self = shift;
my %p = @_;
lib/Alzabo/Driver/MySQL.pm view on Meta::CPAN
sub rollback
{
my $self = shift;
eval { $self->SUPER::rollback };
if ( my $e = $@ )
{
unless ( $e->error =~ /Some non-transactional changed tables/ )
{
if ( Alzabo::Utils::safe_can( $e, 'rethrow' ) )
{
$e->rethrow;
}
else
{
Alzabo::Exception->throw( error => $e );
}
}
}
}
sub get_last_id
{
my $self = shift;
return $self->{dbh}->{mysql_insertid};
lib/Alzabo/Driver/PostgreSQL.pm view on Meta::CPAN
use strict;
use vars qw($VERSION);
use Alzabo::Driver;
use DBD::Pg;
use DBI;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = 2.0;
use base qw(Alzabo::Driver);
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
lib/Alzabo/Driver/PostgreSQL.pm view on Meta::CPAN
# exist yet, but postgres doesn't let us be databaseless, so we
# connect to something else. "template1" should always be there.
my $dbh = $self->_make_dbh( @_, name => 'template1' );
eval { $dbh->do( "CREATE DATABASE " . $dbh->quote_identifier( $self->{schema}->db_schema_name ) ); };
my $e = $@;
eval { $dbh->disconnect; };
Alzabo::Exception::Driver->throw( error => $e ) if $e;
Alzabo::Exception::Driver->throw( error => $@ ) if $@;
}
sub drop_database
{
my $self = shift;
# We can't drop the current database, so we have to connect to
# something else. "template1" should always be there.
$self->disconnect;
my $dbh = $self->_make_dbh( @_, name => 'template1' );
eval { $dbh->do( "DROP DATABASE " . $dbh->quote_identifier( $self->{schema}->db_schema_name ) ); };
my $e = $@;
eval { $dbh->disconnect; };
$e ||= $@;
Alzabo::Exception::Driver->throw( error => $e ) if $e;
}
sub _connect_params
{
my $self = shift;
my %p = @_;
%p = validate( @_, { name => { type => SCALAR },
user => { type => SCALAR | UNDEF,
optional => 1 },
lib/Alzabo/Driver/PostgreSQL.pm view on Meta::CPAN
];
}
sub next_sequence_number
{
my $self = shift;
my $col = shift;
$self->_ensure_valid_dbh;
Alzabo::Exception::Params->throw
( error => "This column (" . $col->name . ") is not sequenced" )
unless $col->sequenced;
my $seq_name;
if ( $col->type =~ /SERIAL/ )
{
$seq_name = join '_', $col->table->name, $col->name;
my $maxlen = $self->identifier_length;
$seq_name = substr( $seq_name, 0, $maxlen - 4 ) if length $seq_name > ($maxlen - 4);
lib/Alzabo/Exceptions.pm view on Meta::CPAN
foreach my $name ( ref $args{abbr} ? @{ $args{abbr} } : $args{abbr} )
{
no strict 'refs';
die "Unknown exception abbreviation '$name'" unless defined &{$name};
*{"${caller}::$name"} = \&{$name};
}
}
{
no strict 'refs';
*{"${caller}::isa_alzabo_exception"} = \&isa_alzabo_exception;
*{"${caller}::rethrow_exception"} = \&rethrow_exception;
}
}
sub isa_alzabo_exception
{
my ($err, $name) = @_;
return unless defined $err;
my $class =
! $name
lib/Alzabo/Exceptions.pm view on Meta::CPAN
{
no strict 'refs';
die "no such exception class $class"
unless defined(${"${class}::VERSION"});
}
return Alzabo::Utils::safe_isa($err, $class);
}
sub rethrow_exception
{
my $err = shift;
return unless $err;
if ( Alzabo::Utils::safe_can( $err, 'rethrow' ) )
{
$err->rethrow;
}
elsif ( ref $err )
{
die $err;
}
Alzabo::Exception->throw( error => $err );
}
package Alzabo::Exception;
sub format
{
my $self = shift;
if (@_)
lib/Alzabo/Exceptions.pm view on Meta::CPAN
that does not actually exist in the specified table.
=item * Alzabo::Exception::NotNullable
An attempt was made to set a non-nullable column to C<NULL>. The
"column_name", "table_name", and "schema_name" fields can be used to
identify the exact column.
=item * Alzabo::Exception::Panic
This exception is thrown when something completely unexpected happens
(think Monty Python).
=item * Alzabo::Exception::Params
This exception is thrown when there is a problem with the parameters
passed to a method or function. These problems can include missing
parameters, invalid values, etc.
=item * Alzabo::Exception::RDBMSRules
A rule for the relevant RDBMS was violated (bad schema name, table
name, column attribute, etc.)
=item * Alzabo::Exception::ReferentialIntegrity
An insert/update/delete was attempted that would violate referential
integrity constraints.
=item * Alzabo::Exception::SQL
An error thrown when there is an attempt to generate invalid SQL via
the Alzabo::SQLMaker module.
=item * Alzabo::Exception::Storable
A error when trying to freeze, thaw, or clone an object using
Storable.
=item * Alzabo::Exception::System
Some sort of system call (file read/write, stat, etc.) failed.
lib/Alzabo/Index.pm view on Meta::CPAN
}
return @c;
}
sub prefix
{
my $self = shift;
my $c = shift;
Alzabo::Exception::Params->throw( error => "Column " . $c->name . " is not part of index." )
unless $self->{columns}->EXISTS( $c->name );
return ($self->{columns}->FETCH( $c->name ))->{prefix};
}
sub unique { $_[0]->{unique} }
sub fulltext { $_[0]->{fulltext} }
sub function { $_[0]->{function} }
lib/Alzabo/Intro.pod view on Meta::CPAN
This is similar to using C<DBI> with the C<RaiseError> attribute set
to a true value.
Its important to note that some methods (such as the driver's
C<rollback()> method) may use C<eval> internally. This means that if
you intend to use them as part of the cleanup after an exception, you
may need to store the original exception in another variable, as C<$@>
will be overwritten at the next C<eval>.
In addition, some methods you might use during cleanup can throw
exceptions of their own.
This is the point where I start wishing Perl had a B<real> exception
handling mechanism built into the language.
=head1 BACKWARDS COMPATIBILITY
Because Alzabo saves the schema objects to disk as raw data structures
using the C<Storable> module, it is possible for a new version of
Alzabo to be incompatible with a saved schema.
lib/Alzabo/MethodMaker.pm view on Meta::CPAN
package Alzabo::MethodMaker;
use strict;
use vars qw($VERSION);
use Alzabo::Exceptions;
use Alzabo::Runtime;
use Alzabo::Utils;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = 2.0;
# types of methods that can be made - only ones that haven't been
# deprecated
my @options = qw( foreign_keys
linking_tables
lookup_columns
row_columns
self_relations
lib/Alzabo/MethodMaker.pm view on Meta::CPAN
sub eval_schema_class
{
my $self = shift;
eval <<"EOF";
package $self->{schema_class};
use base qw( Alzabo::Runtime::Schema Alzabo::DocumentationContainer );
EOF
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
}
sub eval_table_class
{
my $self = shift;
eval <<"EOF";
package $self->{table_class};
use base qw( $self->{class_root}::Table );
sub _row_class { '$self->{row_class}' }
EOF
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
}
sub eval_row_class
{
my $self = shift;
# Need to load this so that ->can checks can see them
require Alzabo::Runtime;
eval <<"EOF";
package $self->{row_class};
use base qw( $self->{class_root}::Row Alzabo::DocumentationContainer );
EOF
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
}
sub make_table_method
{
my $self = shift;
my $t = shift;
my $name = $self->_make_method
( type => 'table',
class => $self->{schema_class},
lib/Alzabo/MethodMaker.pm view on Meta::CPAN
{
my \$s = shift;
my \%p = \@_;
$code
}
}
EOF
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
my $hooks =
$self->_hooks_doc_string( $self->{table_class}, 'pre_insert', 'post_insert' );
$self->{table_class}->add_class_docs
( Alzabo::ClassDocs->new
( group => 'Hooks',
description => "$hooks",
) );
}
lib/Alzabo/MethodMaker.pm view on Meta::CPAN
{
my \$s = shift;
my \%p = \@_;
$code
}
}
EOF
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
my $hooks =
$self->_hooks_doc_string( $self->{row_class}, 'pre_update', 'post_update' );
$self->{row_class}->add_class_docs
( Alzabo::ClassDocs->new
( group => 'Hooks',
description => "$hooks",
) );
}
lib/Alzabo/MethodMaker.pm view on Meta::CPAN
my \%r = \$s->SUPER::select_hash(\@cols);
$post
return \%r;
} );
}
}
EOF
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
my $hooks =
$self->_hooks_doc_string( $self->{row_class}, 'pre_select', 'post_select' );
$self->{row_class}->add_class_docs
( Alzabo::ClassDocs->new
( group => 'Hooks',
description => "$hooks",
) );
}
lib/Alzabo/MethodMaker.pm view on Meta::CPAN
sub delete
{
my \$s = shift;
my \%p = \@_;
$code
}
EOF
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
my $hooks =
$self->_hooks_doc_string( $self->{row_class}, 'pre_delete', 'post_delete' );
$self->{row_class}->add_class_docs
( Alzabo::ClassDocs->new
( group => 'Hooks',
description => "$hooks",
) );
}
lib/Alzabo/QuickRef.pod view on Meta::CPAN
Given a hash of columns and values, this method will update the
database and the object to match those values.
=for html_docs link=L<More|Alzabo::Runtime::Row/update (%hash_of_columns_and_values)>
=item * delete
=for html_docs type=object
Deletes the row from the database. Further attempts to retrieve data
from this row will throw an exception.
=for html_docs link=L<More|Alzabo::Runtime::Row/delete>
=item * rows_by_foreign_key
=for html_docs type=object
Given a foreign key object from the row's table to another table,
returns either an L<C<Alzabo::Runtime::Row>|Alzabo::Runtime::Row>
object or an
lib/Alzabo/RDBMSRules.pm view on Meta::CPAN
package Alzabo::RDBMSRules;
use strict;
use vars qw($VERSION);
use Alzabo::Exceptions ( abbr => [ 'recreate_table_exception' ] );
use Class::Factory::Util;
use Params::Validate qw( validate validate_pos );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = 2.0;
1;
sub new
{
shift;
my %p = @_;
eval "use Alzabo::RDBMSRules::$p{rdbms};";
Alzabo::Exception::Eval->throw( error => $@ ) if $@;
return "Alzabo::RDBMSRules::$p{rdbms}"->new(@_);
}
sub available { __PACKAGE__->subclasses }
# validation
sub validate_schema_name
{
shift()->_virtual;
lib/Alzabo/RDBMSRules.pm view on Meta::CPAN
return @sql;
}
sub _virtual
{
my $self = shift;
my $sub = (caller(1))[3];
Alzabo::Exception::VirtualMethod->throw( error =>
"$sub is a virtual method and must be subclassed in " . ref $self );
}
__END__
=head1 NAME
Alzabo::RDBMSRules - Base class for Alzabo RDBMS rulesets
=head1 SYNOPSIS
lib/Alzabo/RDBMSRules.pm view on Meta::CPAN
=item * column => C<Alzabo::Create::Column> object
=item * attribute => $attribute
=back
This method is a bit different from the others in that it takes an
existing column object and a B<potential> attribute.
It throws an L<C<Alzabo::Exception::RDBMSRules>|Alzabo::Exceptions> if
the attribute is is not valid for the column.
=head2 validate_primary_key (C<Alzabo::Create::Column> object)
Throws an L<C<Alzabo::Exception::RDBMSRules>|Alzabo::Exceptions> if
the column is not a valid primary key for its table.
=head2 validate_sequenced_attribute (C<Alzabo::Create::Column> object)
Throws an L<C<Alzabo::Exception::RDBMSRules>|Alzabo::Exceptions> if
lib/Alzabo/RDBMSRules/MySQL.pm view on Meta::CPAN
my $class = ref $proto || $proto;
return bless {}, $class;
}
sub validate_schema_name
{
my $self = shift;
my $name = shift->name;
Alzabo::Exception::RDBMSRules->throw( error => "Schema name must be at least one character long" )
unless length $name;
# These are characters that are illegal in a dir name. I'm trying
# to accomodate both Win32 and UNIX here.
foreach my $c ( qw( : \ / ) )
{
Alzabo::Exception::RDBMSRules->throw( error => "Schema name contains an illegal character ($c)" )
if index($name, $c) != -1;
}
}
# Note: These rules are valid for MySQL 3.22.x. MySQL 3.23.x is
# actually less restrictive but this should be enough freedom.
sub validate_table_name
{
my $self = shift;
my $name = shift->name;
Alzabo::Exception::RDBMSRules->throw( error => "Table name must be at least one character long" )
unless length $name;
Alzabo::Exception::RDBMSRules->throw( error => "Table name is too long. Names must be 64 characters or less." )
if length $name >= 64;
Alzabo::Exception::RDBMSRules->throw( error => "Table name must only contain alphanumerics or underscore(_)." )
if $name =~ /\W/;
}
sub validate_column_name
{
my $self = shift;
my $name = shift->name;
Alzabo::Exception::RDBMSRules->throw( error => "Column name must be at least one character long" )
unless length $name;
Alzabo::Exception::RDBMSRules->throw( error => 'Name is too long. Names must be 64 characters or less.' )
if length $name >= 64;
Alzabo::Exception::RDBMSRules->throw( error =>
'Name contains characters that are not alphanumeric or the dollar sign ($).' )
if $name =~ /[^\w\$]/;
Alzabo::Exception::RDBMSRules->throw( error =>
'Name contains only digits. Names must contain at least one alpha character.' )
unless $name =~ /[^\W\d]/;
}
sub validate_column_type
{
my $self = shift;
my $type = shift;
$type = 'INTEGER' if uc $type eq 'INT';
lib/Alzabo/RDBMSRules/MySQL.pm view on Meta::CPAN
return uc $type if $simple_types{uc $type};
return 'DOUBLE' if $type =~ /DOUBLE\s+PRECISION/i;
return 'CHAR' if $type =~ /\A(?:NATIONAL\s+)?CHAR(?:ACTER)?/i;
return 'VARCHAR' if $type =~ /\A(?:NATIONAL\s+)?(?:VARCHAR|CHARACTER VARYING)/i;
my $t = $self->_capitalize_type($type);
return $t if $t;
Alzabo::Exception::RDBMSRules->throw( error => "Unrecognized type: $type" );
}
sub _capitalize_type
{
my $self = shift;
my $type = shift;
if ( uc substr($type, 0, 4) eq 'ENUM' )
{
return 'ENUM' . substr($type, 4);
lib/Alzabo/RDBMSRules/MySQL.pm view on Meta::CPAN
}
sub validate_column_length
{
my $self = shift;
my $column = shift;
# integer column
if ( $column->type =~ /\A(?:(?:(?:TINY|SMALL|MEDIUM|BIG)?INT)|INTEGER)/i )
{
Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." )
if defined $column->length && $column->length > 255;
Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." )
if defined $column->precision;
return;
}
if ( $column->type =~ /\A(?:FLOAT|DOUBLE(?:\s+PRECISION)?|REAL)/i )
{
if (defined $column->length)
{
Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." )
if $column->length > 255;
Alzabo::Exception::RDBMSRules->throw( error => "Max display value specified without floating point precision." )
unless defined $column->precision;
Alzabo::Exception::RDBMSRules->throw( error =>
"Floating point precision is too high. The maximum value is " .
"30 or the maximum display size - 2, whichever is smaller." )
if $column->precision > 30 || $column->precision > ($column->length - $column->precision);
}
return;
}
if ( $column->type =~ /\A(?:DECIMAL|NUMERIC)\z/i )
{
Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." )
if defined $column->length && $column->length > 255;
Alzabo::Exception::RDBMSRules->throw( error =>
"Floating point precision is too high. The maximum value is " .
"30 or the maximum display size - 2, whichever is smaller." )
if defined $column->precision && ($column->precision > 30 || $column->precision > ($column->length - 2) );
return;
}
if ( uc $column->type eq 'TIMESTAMP' )
{
Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 14." )
if defined $column->length && $column->length > 14;
Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." )
if defined $column->precision;
return;
}
if ( $column->type =~ /\A(?:(?:NATIONAL\s+)?VAR)?(?:CHAR|BINARY)/i )
{
Alzabo::Exception::RDBMSRules->throw( error => "(VAR)CHAR and (VAR)BINARY columns must have a length provided." )
unless defined $column->length && $column->length > 0;
Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." )
if $column->length > 255;
Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." )
if defined $column->precision;
return;
}
if ( uc $column->type eq 'YEAR' )
{
Alzabo::Exception::RDBMSRules->throw( error => "Valid values for the length specification are 2 or 4." )
if defined $column->length && ($column->length != 2 && $column->length != 4);
return;
}
Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a length or precision." )
if defined $column->length || defined $column->precision;
}
# placeholder in case we decide to try to do something better later
sub validate_table_attribute { 1 }
sub validate_column_attribute
{
my $self = shift;
my %p = @_;
my $column = $p{column};
my $a = uc $p{attribute};
$a =~ s/\A\s//;
$a =~ s/\s\z//;
if ( $a eq 'UNSIGNED' || $a eq 'ZEROFILL' )
{
Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to numeric columns" )
unless $column->is_numeric;
return;
}
if ( $a eq 'AUTO_INCREMENT' )
{
Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to integer columns" )
unless $column->is_integer;
return;
}
if ($a eq 'BINARY')
{
Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to character columns" )
unless $column->is_character;
return;
}
return if $a =~ /\A(?:REFERENCES|UNIQUE\z)/i;
Alzabo::Exception::RDBMSRules->throw( error => "Unrecognized attribute: $a" );
}
sub validate_primary_key
{
my $self = shift;
my $col = shift;
Alzabo::Exception::RDBMSRules->throw( error => 'Blob columns cannot be part of a primary key' )
if $col->type =~ /\A(?:TINY|MEDIUM|LONG)?(?:BLOB|TEXT)\z/i;
}
sub validate_sequenced_attribute
{
my $self = shift;
my $col = shift;
Alzabo::Exception::RDBMSRules->throw( error => 'Non-integer columns cannot be sequenced' )
unless $col->is_integer;
Alzabo::Exception::RDBMSRules->throw( error => 'Only one sequenced column per table is allowed.' )
if grep { $_ ne $col && $_->sequenced } $col->table->columns;
}
sub validate_index
{
my $self = shift;
my $index = shift;
foreach my $c ( $index->columns )
{
my $prefix = $index->prefix($c);
if (defined $prefix)
{
Alzabo::Exception::RDBMSRules->throw( error => "Invalid prefix specification ('$prefix')" )
unless $prefix =~ /\d+/ && $prefix > 0;
Alzabo::Exception::RDBMSRules->throw( error => 'Non-character/blob columns cannot have an index prefix' )
unless $c->is_blob || $c->is_character || $c->type =~ /^(?:VAR)BINARY$/i;
}
if ( $c->is_blob )
{
Alzabo::Exception::RDBMSRules->throw( error => 'Blob columns must have an index prefix' )
unless $prefix || $index->fulltext;
}
if ( $index->fulltext )
{
Alzabo::Exception::RDBMSRules->throw( error => 'A fulltext index can only include text or char columns' )
unless $c->is_character;
}
}
Alzabo::Exception::RDBMSRules->throw( error => 'An fulltext index cannot be unique' )
if $index->unique && $index->fulltext;
Alzabo::Exception::RDBMSRules->throw( error => 'MySQL does not support function indexes' )
if defined $index->function;
}
sub type_is_integer
{
my $self = shift;
my $col = shift;
my $type = uc $col->type;
return 1 if $type =~ /\A(?:(?:TINY|SMALL|MEDIUM|BIG)?INT|INTEGER)\z/;
lib/Alzabo/RDBMSRules/PostgreSQL.pm view on Meta::CPAN
use Alzabo::Exceptions ( abbr => [ 'recreate_table_exception' ] );
use Alzabo::RDBMSRules;
use Digest::MD5;
use Text::Balanced ();
use base qw(Alzabo::RDBMSRules);
use Params::Validate qw( validate_pos );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
$VERSION = 2.0;
1;
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
return bless {}, $class;
}
sub validate_schema_name
{
my $self = shift;
my $name = shift->name;
$self->_check_name($name, 'schema');
Alzabo::Exception::RDBMSRules->throw( error => "Schema name ($name) contains a single quote char (')" )
if index($name, "'") != -1;
}
sub validate_table_name
{
my $self = shift;
$self->_check_name( shift->name, 'table' );
}
lib/Alzabo/RDBMSRules/PostgreSQL.pm view on Meta::CPAN
my $self = shift;
$self->_check_name( shift->name, 'column' );
}
sub _check_name
{
my $self = shift;
my $name = shift;
Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) must be at least one character long" )
unless length $name;
Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) is too long. Names must be 31 characters or less." )
if length $name > 31;
Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) must start with an alpha or underscore(_) and must contain only alphanumerics and underscores." )
unless $name =~ /\A[a-zA-Z]\w*\z/;
}
sub validate_column_type
{
my $self = shift;
my $type = uc shift;
my $table = shift;
if ( $table->primary_key_size > 1 )
lib/Alzabo/RDBMSRules/PostgreSQL.pm view on Meta::CPAN
return 'INT8' if $type eq 'BIGINT';
return $type if $simple_types{$type};
return $type if $type =~ /BIT\s+VARYING/;
return $type if $type =~ /CHARACTER\s+VARYING/;
return $type if $type =~ /\ABOX|CIRCLE|LINE|LSEG|PATH|POINT|POLYGON/;
Alzabo::Exception::RDBMSRules->throw( error => "Invalid column type: $type" );
}
sub validate_column_length
{
my $self = shift;
my $column = shift;
if ( defined $column->length )
{
Alzabo::Exception::RDBMSRules->throw( error => "Length is not supported except for char, varchar, decimal, float, and numeric columns (" . $column->name . " column)" )
unless $column->type =~ /\A(?:(?:VAR)?CHAR|CHARACTER|DECIMAL|FLOAT|NUMERIC|(?:VAR)?BIT|BIT VARYING)\z/i;
}
if ( defined $column->precision )
{
Alzabo::Exception::RDBMSRules->throw( error => "Precision is not supported except for decimal, float, and numeric columns" )
unless $column->type =~ /\A(?:DECIMAL|FLOAT|NUMERIC)\z/i;
}
}
# placeholder in case we decide to try to do something better later
sub validate_table_attribute { 1 }
sub validate_column_attribute
{
my $self = shift;
my %p = @_;
my $column = $p{column};
my $type = $column->type;
my $a = uc $p{attribute};
$a =~ s/\A\s//;
$a =~ s/\s\z//;
return if $a =~ /\A(?:UNIQUE\z|CHECK|CONSTRAINT|REFERENCES)/i;
Alzabo::Exception::RDBMSRules->throw( error => "Only column constraints are supported as column attributes" )
}
sub validate_primary_key
{
my $self = shift;
my $col = shift;
my $serial_col = (grep { $_->type =~ /^(?:SERIAL(?:4|8)?|BIGSERIAL)$/ } $col->table->primary_key)[0];
if ( defined $serial_col &&
$serial_col->name ne $col->name )
lib/Alzabo/RDBMSRules/PostgreSQL.pm view on Meta::CPAN
? 'INT4'
: 'INT8' );
}
}
sub validate_sequenced_attribute
{
my $self = shift;
my $col = shift;
Alzabo::Exception::RDBMSRules->throw( error => 'Non-number columns cannot be sequenced' )
unless $col->is_integer || $col->is_floating_point;
}
sub validate_index
{
my $self = shift;
my $index = shift;
foreach my $c ( $index->columns )
{
Alzabo::Exception::RDBMSRules->throw( error => "PostgreSQL does not support index prefixes" )
if defined $index->prefix($c)
}
Alzabo::Exception::RDBMSRules->throw( error => "PostgreSQL does not support fulltext indexes" )
if $index->fulltext;
}
sub type_is_integer
{
my $self = shift;
my $col = shift;
my $type = uc $col->type;
return 1 if $type =~ /\A(?:
lib/Alzabo/Runtime.pm view on Meta::CPAN
$sql->subgroup_start;
$needs_op = 0;
}
my $x = 0;
foreach my $clause (@$conditions)
{
if (ref $clause)
{
Alzabo::Exception::Params->throw
( error => "Individual where clause components must be array references" )
unless Alzabo::Utils::is_arrayref($clause);
Alzabo::Exception::Params->throw
( error => "Individual where clause components cannot be empty" )
unless @$clause;
if ($needs_op)
{
my $op = $x || $has_start ? 'and' : $needed_op;
$sql->$op();
}
$sql->condition(@$clause);
lib/Alzabo/Runtime.pm view on Meta::CPAN
$sql->subgroup_start;
$needs_op = 0;
}
elsif ($clause eq ')')
{
$sql->subgroup_end;
$needs_op = 1;
}
else
{
Alzabo::Exception::Params->throw( error => "Invalid where clause specification: $clause" );
}
$x++;
}
$sql->subgroup_end if $has_start;
}
sub process_order_by_clause
{
_process_by_clause(@_, 'order');
lib/Alzabo/Runtime/Column.pm view on Meta::CPAN
package Alzabo::Runtime::Column;
use strict;
use vars qw($VERSION);
use Alzabo::Runtime;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
use base qw(Alzabo::Column);
$VERSION = 2.0;
sub alias_clone
{
my $self = shift;
my %p = validate( @_, { table => { isa => 'Alzabo::Runtime::Table' },
lib/Alzabo/Runtime/Cursor.pm view on Meta::CPAN
sub all_rows
{
shift->_virtual;
}
sub _virtual
{
my $self = shift;
my $sub = (caller(1))[3];
Alzabo::Exception::VirtualMethod->throw
( error =>
"$sub is a virtual method and must be subclassed in " . ref $self );
}
sub reset
{
my $self = shift;
$self->{statement}->execute( $self->{statement}->bind );
lib/Alzabo/Runtime/ForeignKey.pm view on Meta::CPAN
push @one_to_one_vals, $pair->[0]->name . ' = ' . $vals{ $pair->[0]->name };
}
}
if ( $self->is_one_to_one && ! $has_nulls )
{
if ( @one_to_one_where &&
$self->table_from->row_count( where => \@one_to_one_where ) )
{
my $err = '(' . (join ', ', @one_to_one_vals) . ') already exists in the ' . $self->table_from->name . ' table';
Alzabo::Exception::ReferentialIntegrity->throw( error => $err );
}
}
}
sub _check_existence
{
my $self = shift;
my ($col, $val) = @_;
unless ( $self->table_to->row_count( where => [ $col, '=', $val ] ) )
{
Alzabo::Exception::ReferentialIntegrity->throw( error => 'Foreign key must exist in foreign table. No rows in ' . $self->table_to->name . ' where ' . $col->name . " = $val" );
}
}
sub register_delete
{
my $self = shift;
my $row = shift;
my @update = grep { $_->nullable } $self->columns_to;
lib/Alzabo/Runtime/InsertHandle.pm view on Meta::CPAN
}
# must come after call to ->get_last_id for MySQL because the
# id will no longer be available after the transaction ends.
$schema->commit if @fk;
};
if (my $e = $@)
{
eval { $schema->rollback };
rethrow_exception $e;
}
return unless defined wantarray;
return $self->{table}->row_by_pk( pk => \%id,
no_cache => $self->{no_cache},
%p,
);
}
lib/Alzabo/Runtime/JoinCursor.pm view on Meta::CPAN
package Alzabo::Runtime::JoinCursor;
use strict;
use vars qw($VERSION);
use Alzabo::Exceptions;
use Alzabo::Runtime;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
use base qw( Alzabo::Runtime::Cursor );
$VERSION = 2.0;
use constant NEW_SPEC => { statement => { isa => 'Alzabo::DriverStatement' },
tables => { type => ARRAYREF },
};
sub new
lib/Alzabo/Runtime/Row.pm view on Meta::CPAN
=head2 select (@list_of_column_names)
Returns a list of values matching the specified columns in a list
context. In scalar context it returns only a single value (the first
column specified).
If no columns are specified, it will return the values for all of the
columns in the table, in the order that are returned by
L<C<Alzabo::Runtime::Table-E<gt>columns>|Alzabo::Runtime::Table/columns>.
This method throws an
L<C<Alzabo::Runtime::NoSuchRowException>|Alzabo::Exceptions> if called
on a deleted row.
=head2 select_hash (@list_of_column_names)
Returns a hash of column names to values matching the specified
columns.
If no columns are specified, it will return the values for all of the
columns in the table.
This method throws an
L<C<Alzabo::Runtime::NoSuchRowException>|Alzabo::Exceptions> if called
on a deleted row.
=head2 update (%hash_of_columns_and_values)
Given a hash of columns and values, attempts to update the database to
and the object to represent these new values.
It returns a boolean value indicating whether or not any data was
actually modified.
This method throws an
L<C<Alzabo::Runtime::NoSuchRowException>|Alzabo::Exceptions> if called
on a deleted row.
=head2 refresh
Refreshes the object against the database. This can be used when you
want to ensure that a row object is up to date in regards to the
database state.
This method throws an
L<C<Alzabo::Runtime::NoSuchRowException>|Alzabo::Exceptions> if called
on a deleted row.
=head2 delete
Deletes the row from the RDBMS and changes the object's state to
deleted.
For potential rows, this method simply changes the object's state.
This method throws an
L<C<Alzabo::Runtime::NoSuchRowException>|Alzabo::Exceptions> if called
on a deleted row.
=head2 id_as_string
Returns the row's id value as a string. This can be passed to the
L<C<Alzabo::Runtime::Table-E<gt>row_by_id>|Alzabo::Runtime::Table/row_by_id>
method to recreate the row later.
For potential rows, this method always return an empty string.
This method throws an
L<C<Alzabo::Runtime::NoSuchRowException>|Alzabo::Exceptions> if called
on a deleted row.
=head2 is_live
Indicates whether or not the given row represents an actual row in the
database.
=head2 is_potential
lib/Alzabo/Runtime/RowCursor.pm view on Meta::CPAN
package Alzabo::Runtime::RowCursor;
use strict;
use vars qw($VERSION);
use Alzabo::Exceptions;
use Alzabo::Runtime;
use Params::Validate qw( :all );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );
use base qw( Alzabo::Runtime::Cursor );
$VERSION = 2.0;
use constant NEW_SPEC => { statement => { isa => 'Alzabo::DriverStatement' },
table => { isa => 'Alzabo::Runtime::Table' },
};
sub new
lib/Alzabo/Runtime/RowState/Live.pm view on Meta::CPAN
}
}
else
{
eval { $class->_get_prefetch_data($row) };
if ( my $e = $@ )
{
return if isa_alzabo_exception( $e, 'Alzabo::Exception::NoSuchRow' );
rethrow_exception $e;
}
}
unless ( keys %{ $row->{data} } > keys %{ $row->{pk} } )
{
# Need to try to fetch something to confirm that this row exists!
my $sql = ( $row->schema->sqlmaker->
select( ($row->table->primary_key)[0] )->
from( $row->table ) );
lib/Alzabo/Runtime/RowState/Live.pm view on Meta::CPAN
my $schema = $row->schema;
my @fk; # this never gets populated unless referential integrity
# checking is on
my @set;
my $includes_pk = 0;
foreach my $k ( sort keys %data )
{
# This will throw an exception if the column doesn't exist.
my $c = $row->table->column($k);
if ( $row->_cached_data_is_same( $k, $data{$k} ) )
{
delete $data{$k};
next;
}
$includes_pk = 1 if $c->is_primary_key;
Alzabo::Exception::NotNullable->throw
( error => $c->name . " column in " . $row->table->name . " table cannot be null.",
column_name => $c->name,
table_name => $c->table->name,
schema_name => $schema->name,
)
unless defined $data{$k} || $c->nullable || defined $c->default;
push @fk, $row->table->foreign_keys_by_column($c)
if $schema->referential_integrity;
lib/Alzabo/Runtime/RowState/Live.pm view on Meta::CPAN
$schema->driver->do( sql => $sql->sql,
bind => $sql->bind );
$schema->commit if @fk;
};
if (my $e = $@)
{
eval { $schema->rollback };
rethrow_exception $e;
}
while ( my( $k, $v ) = each %data )
{
# These can't be stored until they're fetched from the database again
if ( Alzabo::Utils::safe_isa( $v, 'Alzabo::SQLMaker::Function' ) )
{
delete $row->{data}{$k};
next;
}
lib/Alzabo/Runtime/RowState/Live.pm view on Meta::CPAN
$schema->driver->do( sql => $sql->sql,
bind => $sql->bind );
$schema->commit if @fk;
};
if (my $e = $@)
{
eval { $schema->rollback };
rethrow_exception $e;
}
$row->set_state( 'Alzabo::Runtime::RowState::Deleted' );
}
sub is_potential { 0 }
sub is_live { 1 }
sub is_deleted { 0 }
( run in 0.481 second using v1.01-cache-2.11-cpan-496ff517765 )