[Rt-commit] r3840 - in Jifty-DBI/trunk: . lib/Jifty/DBI
jesse at bestpractical.com
jesse at bestpractical.com
Sun Sep 11 18:01:09 EDT 2005
Author: jesse
Date: Sun Sep 11 18:01:09 2005
New Revision: 3840
Modified:
Jifty-DBI/trunk/ (props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm
Log:
r15678 at hualien: jesse | 2005-09-10 22:44:16 -0400
* Still not working (the majority of the refactoring is done)
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm Sun Sep 11 18:01:09 2005
@@ -6,6 +6,8 @@
use vars qw($AUTOLOAD);
use Class::ReturnValue;
+our %COLUMNS;
+
=head1 NAME
Jifty::DBI::Record - Superclass for records loaded by Jifty::DBI::Collection
@@ -15,25 +17,10 @@
package MyRecord;
use base qw/Jifty::DBI::Record/;
- sub _Init {
- my $self = shift;
- my $DBIxHandle =
- shift; # A Jifty::DBI::Handle::foo object for your database
-
- $self->_handle($DBIxHandle);
- $self->table("Users");
- }
-
- # Tell Record what the primary keys are
- sub _primary_keys {
- return ['id'];
- }
-
-
-
=head1 DESCRIPTION
-Jifty::DBI::Record is designed to work with Jifty::DBI.
+Jifty::DBI::Record encapuslates records and tables as part of the L<Jifty::DBI>
+object-relational mapper.
=head2 What is it trying to do.
@@ -67,23 +54,7 @@
have guessed the '_' suggests that these are private methods, they are.
They will get called by your record objects constructor.
-=over 4
-
-=item '_Init'
-Defines what table we are talking about, and set a variable to store
-the database handle.
-
-=item '_class_accessible
-
-Defines what operations may be performed on various data selected
-from the database. For example you can define fields to be mutable,
-or immutable, there are a few other options but I don't understand
-what they do at this time.
-
-=back
-
-And really, thats it. So lets have some sample code.
=head2 An Annotated Example
@@ -339,104 +310,124 @@
my $self = $_[0];
no strict 'refs';
- my ($Attrib) = ( $AUTOLOAD =~ /::(\w+)$/o );
+ my ( $column_name, $action ) = $self->_parse_autoload_method($AUTOLOAD);
- if ( $self->_accessible( $Attrib, 'read' ) ) {
- *{$AUTOLOAD} = sub { return ( $_[0]->_value($Attrib) ) };
- goto &$AUTOLOAD;
+ unless ( $action and $column_name ) {
+ my ( $package, $filename, $line ) = caller;
+ die "$AUTOLOAD Unimplemented in $package. ($filename line $line) \n";
}
- elsif ( $self->_accessible( $Attrib, 'record-read' ) ) {
- *{$AUTOLOAD}
- = sub { $_[0]->_to_record( $Attrib, $_[0]->__value($Attrib) ) };
- goto &$AUTOLOAD;
+
+ my $column = $self->column($column_name);
+
+ unless ($column) {
+ my ( $package, $filename, $line ) = caller;
+ die "$AUTOLOAD Unimplemented in $package. ($filename line $line) \n";
+
}
- elsif ( $self->_accessible( $Attrib, 'foreign-collection' ) ) {
- *{$AUTOLOAD} = sub { $_[0]->_collection_value($Attrib) };
+
+ if ( $action eq 'read' and $column->readable ) {
+
+ if ( $column->refers_to_record_class ) {
+ *{$AUTOLOAD}
+ = sub { $_[0]->_to_record( $column_name, $_[0]->__value($column_name) ) };
+ }
+ elsif ( $column->refers_to_collection_class ) {
+ *{$AUTOLOAD} = sub { $_[0]->_collection_value($column_name) };
+ }
+ else {
+ *{$AUTOLOAD} = sub { return ( $_[0]->_value($column_name) ) };
+ }
goto &$AUTOLOAD;
}
- elsif ( $AUTOLOAD =~ /.*::set_(\w+)/o ) {
- $Attrib = $1;
- if ( $self->_accessible( $Attrib, 'write' ) ) {
- *{$AUTOLOAD} = sub {
- return ( $_[0]->_set( field => $Attrib, value => $_[1] ) );
- };
- goto &$AUTOLOAD;
- }
- elsif ( $self->_accessible( $Attrib, 'record-write' ) ) {
+ if ( $action eq 'write' and $column->writeable ) {
+
+ if ( $column->refers_to_record_class ) {
*{$AUTOLOAD} = sub {
my $self = shift;
my $val = shift;
$val = $val->id
if UNIVERSAL::isa( $val, 'Jifty::DBI::Record' );
- return ( $self->_set( field => $Attrib, value => $val ) );
+ return ( $self->_set( field => $column_name, value => $val ) );
};
- goto &$AUTOLOAD;
- }
- elsif ( $self->_accessible( $Attrib, 'read' ) ) {
- *{$AUTOLOAD} = sub { return ( 0, 'Immutable field' ) };
- goto &$AUTOLOAD;
}
else {
- return ( 0, 'Nonexistant field?' );
- }
- }
- elsif ( $AUTOLOAD =~ /.*::(\w+?)_obj$/o ) {
- $Attrib = $1;
- if ( $self->_accessible( $Attrib, 'object' ) ) {
*{$AUTOLOAD} = sub {
- return (shift)->_object(
- field => $Attrib,
- args => [@_],
- );
+ return ( $_[0]->_set( field => $column_name, value => $_[1] ) );
};
- goto &$AUTOLOAD;
- }
- else {
- return ( 0, 'No object mapping for field' );
}
+ goto &$AUTOLOAD;
}
- #Previously, I checked for writability here. but I'm not sure that's the
- #right idea. it breaks the ability to do ValidateQueue for a ticket
- #on creation.
-
- elsif ( $AUTOLOAD =~ /.*::validate_(\w+)/o ) {
- $Attrib = $1;
-
- *{$AUTOLOAD} = sub { return ( $_[0]->_validate( $Attrib, $_[1] ) ) };
+ elsif ( $action eq 'validate' ) {
+ *{$AUTOLOAD}
+ = sub { return ( $_[0]->_validate( $column_name, $_[1] ) ) };
goto &$AUTOLOAD;
}
- # TODO: if autoload = 0 or 1 _ then a combination of lowercase and _ chars,
- # turn them into studlycapped phrases
-
else {
- my ( $package, $filename, $line );
- ( $package, $filename, $line ) = caller;
+ my ( $package, $filename, $line ) = caller;
die "$AUTOLOAD Unimplemented in $package. ($filename line $line) \n";
}
}
-=head2 _accessible KEY MODE
+=head2 _parse_autoload_method $AUTOLOAD
+
+Parses autoload methods and attempts to determine if they're
+set, get or validate calls.
+
+Returns a tuple of (COLUMN_NAME, ACTION);
+
+=cut
+
+sub _parse_autoload_method {
+ my $self = shift;
+ my $method = shift;
+
+ my ($column_name, $action);
+
+ if ( $$method =~ /.*::set_(\w+)/o ) {
+ $column_name = $1;
+ $action = 'write';
+ }
+ elsif ( $$method =~ /.*::validate_(\w+)/o ) {
+ $column_name = $1;
+ $action = 'validate';
+
+
+ }
+ elsif ( $$method =~ /::(\w+)$/o) {
+ $column_name = $1;
+ $action = 'read';
+
+ }
+ return ($column_name, $action);
+
+}
+=head2 _accessible COLUMN ATTRIBUTE
Private method.
-Returns undef unless C<KEY> is accessible in C<MODE> otherwise returns C<MODE> value
+Returns undef unless C<COLUMN> has a true value for C<ATTRIBUTE>.
+
+Otherwise returns C<COLUMN>'s value for that attribute.
+
=cut
sub _accessible {
my $self = shift;
- my $attr = shift;
- my $mode = lc( shift || '' );
+ my $column_name = shift;
+ my $attribute = lc( shift || '' );
+
+
+ my $col = $self->column($column_name);
+ return undef unless ($col and $col->can($attribute));
+ return $col->$attribute();
- my $attribute = $self->_class_accessible(@_)->{$attr};
- return unless defined $attribute;
- return $attribute->{$mode};
}
=head2 _primary_keys
@@ -470,29 +461,39 @@
sub _class_accessible {
my $self = shift;
- my $accessible = {};
- foreach my $key ( $self->_primary_keys ) {
- $accessible->{$key} = { 'read' => 1 };
+ foreach my $column_name ( $self->_primary_keys ) {
+ my $column = $self->add_column($column_name);
+ $column->read(1);
}
my $schema = $self->schema;
- for my $field ( keys %$schema ) {
- if ( $schema->{$field}{'TYPE'} ) {
- $accessible->{$field} = { 'read' => 1, 'write' => 1 };
+ for my $column_name ( keys %$schema ) {
+ my $column = $self->add_column($column_name);
+ if ( $schema->{$column_name}{'TYPE'} ) {
+ $column->read(1);
+ $column->write(1);
+
}
- elsif ( my $refclass = $schema->{$field}{'REFERENCES'} ) {
+ elsif ( my $refclass = $schema->{$column_name}{'REFERENCES'} ) {
if ( UNIVERSAL::isa( $refclass, 'Jifty::DBI::Record' ) ) {
- if ($field =~ /(.*)_id$/) {
- $accessible->{$field} = { 'read' => 1, 'write' => 1 };
- $accessible->{$1} = { 'record-read' => 1, 'column' => $field };
- } else {
- $accessible->{$field} = { 'record-read' => 1, 'record-write' => 1 };
- }
+ if ( $column_name =~ /(.*)_id$/ ) {
+ $column->read(1);
+ $column->write(1);
+
+ my $virtual_column = $self->add_column($1);
+ $virtual_column->refers_to_record_class($refclass);
+ $virtual_column->alias_for_column($column_name);
+ }
+ else {
+ $column->refers_to_record_class($refclass);
+ $column->read(1);
+ $column->write(1);
+ }
}
elsif ( UNIVERSAL::isa( $refclass, 'Jifty::DBI::Collection' ) ) {
- $accessible->{$field} = { 'foreign-collection' => 1 };
+ $column->refers_to_collection_class($refclass);
}
else {
warn "Error: $refclass neither Record nor Collection";
@@ -500,30 +501,40 @@
}
}
- return $accessible;
}
+=head2 _to_record COLUMN VALUE
+
+This B<PRIVATE> method takes a column name and a value for that column.
+
+It returns C<undef> unless C<COLUMN> is a valid column for this record
+that refers to another record class.
+
+If it is valid, this method returns a new record object with an id
+of C<VALUE>.
+
+=cut
+
+
sub _to_record {
my $self = shift;
- my $field = shift;
+ my $column_name = shift;
my $value = shift;
- return unless defined $value;
- my $schema = $self->schema;
- my $description = $schema->{$field} || $schema->{$field . "_id"};
-
- die "Can't get schema for $field on $self" unless $description;
- return unless $description;
+ my $column = $self->column($column_name);
+ my $classname = $column->references_record_class();
- return $value unless $description->{'REFERENCES'};
- my $classname = $description->{'REFERENCES'};
+ return unless defined $value;
+ return undef unless $classname;
return unless UNIVERSAL::isa( $classname, 'Jifty::DBI::Record' );
-# XXX TODO FIXME perhaps this is not what should be passed to new, but it needs it
+ # XXX TODO FIXME we need to figure out the right way to call new here
+ # perhaps the handle should have an initiializer for records/collections
+
my $object = $classname->new( $self->_handle );
$object->load_by_id($value);
return $object;
@@ -550,37 +561,60 @@
return $coll;
}
+=head2 add_column
+
+=cut
+
+sub add_column {
+ my $self = shift;
+ my $name = shift;
+ $name = lc $name;
+ $COLUMNS{$name} = Jifty::DBI::Column->new() unless exists $COLUMNS{$name};
+ $COLUMNS{$name}->name($name);
+}
+
+
+=head2 column
+
+=cut
+
+sub column {
+ my $self = shift;
+ my $name = shift;
+ $name = lc $name;
+ return $COLUMNS{$name};
+
+}
+
+sub columns {
+ return values %COLUMNS;
+}
+
# sub {{{ readable_attributes
=head2 readable_attributes
-Returns an array of the attributes of this class defined as "read" =>
-1 in this class' _class_accessible datastructure
+Returns a list this table's readable columns
+XXX TODO actuall returns the column objects
=cut
sub readable_attributes {
my $self = shift;
- my $ca = $self->_class_accessible();
- my @readable = grep { $ca->{$_}->{'read'} or $ca->{$_}->{'record-read'} }
- keys %{$ca};
- return (@readable);
+ return grep { $_->readable } @{$self->columns};
}
=head2 writable_attributes
-Returns an array of the attributes of this class defined as "write" =>
-1 in this class' _class_accessible datastructure
+Returns a list of this table's writable columns
+
+XXX TODO returns the column objects
=cut
sub writable_attributes {
my $self = shift;
- my $ca = $self->_class_accessible();
- my @writable
- = grep { $ca->{$_}->{'write'} || $ca->{$_}->{'record-write'} }
- keys %{$ca};
- return @writable;
+ return grep { $_->writeable } @{$self->columns};
}
=head2 __value
@@ -594,7 +628,10 @@
my $self = shift;
my $field = lc shift;
- $field = $self->_accessible($field, "column") while $self->_accessible($field, "column");
+ # If the requested column is actually an alias for another, resolve it.
+
+ $field = $self->column($field)->alias_for_column()
+ while $self->column($field)->alias_for_column();
if ( !$self->{'fetched'}{$field} and my $id = $self->id() ) {
my $pkey = $self->_primary_key();
@@ -643,15 +680,20 @@
my $self = shift;
my %args = (
- 'field' => undef,
+ 'column' => undef,
'value' => undef,
- 'is_sql' => undef,
+ 'is_sql_function' => undef,
@_
);
- $args{'column'} = delete $args{'field'};
- $args{'is_sql_function'} = delete $args{'is_sql'};
-
+ if ($args{'field'} ) {
+ Carp::cluck("field in ->set is deprecated");
+ $args{'column'} = delete $args{'field'};
+ }
+ if ($args{'is_sql'}) {
+ Carp::cluck("is_sql in ->set is deprecated");
+ $args{'is_sql_function'} = delete $args{'is_sql'};
+ }
my $ret = Class::ReturnValue->new();
unless ( $args{'column'} ) {
@@ -663,7 +705,7 @@
);
return ( $ret->return_value );
}
- my $column = lc $args{'column'};
+ my $column_name = lc $args{'column'};
if ( !defined( $args{'value'} ) ) {
$ret->as_array( 0, "No value passed to _set" );
$ret->as_error(
@@ -673,8 +715,8 @@
);
return ( $ret->return_value );
}
- elsif ( ( defined $self->__value($column) )
- and ( $args{'value'} eq $self->__value($column) ) )
+ elsif ( ( defined $self->__value($column_name) )
+ and ( $args{'value'} eq $self->__value($column_name) ) )
{
$ret->as_array( 0, "That is already the current value" );
$ret->as_error(
@@ -686,7 +728,7 @@
}
# First, we truncate the value, if we need to.
- #
+
$args{'value'} = $self->truncate_value( $args{'column'}, $args{'value'} );
@@ -701,31 +743,30 @@
return ( $ret->return_value );
}
- $args{'table'} = $self->table();
- $args{'primary_keys'} = { $self->primary_keys() };
# The blob handling will destroy $args{'Value'}. But we assign
# that back to the object at the end. this works around that
my $unmunged_value = $args{'value'};
unless ( $self->_handle->knows_blobs ) {
+ my $column = $self->column($column_name);
# Support for databases which don't deal with LOBs automatically
- my $ca = $self->_class_accessible();
- my $key = $args{'column'};
- if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i ) {
- my $bhash
- = $self->_handle->blob_params( $key, $ca->{$key}->{'type'} );
+ if ( $column->type =~ /^(text|longtext|clob|blob|lob)$/i ) {
+ my $bhash = $self->_handle->blob_params( $column_name, $column->type );
$bhash->{'value'} = $args{'value'};
$args{'value'} = $bhash;
}
}
- my $val = $self->_handle->update_record_value(%args);
+ my $val = $self->_handle->update_record_value(
+ %args,
+ table => $self->table(),
+ primary_keys => { $self->primary_keys() }
+
+ );
unless ($val) {
- my $message = $args{'column'}
- . " could not be set to "
- . $args{'value'} . ".";
+ my $message = $args{'column'} . " could not be set to " . $args{'value'} . ".";
$ret->as_array( 0, $message );
$ret->as_error(
errno => 4,
@@ -739,10 +780,10 @@
# then we need to reload the object from the DB to know what's
# really going on. (ex SET Cost = Cost+5)
if ( $args{'is_sql_function'} ) {
- $self->Load( $self->Id );
+ $self->load_by_id( $self->id );
}
else {
- $self->{'values'}->{"$column"} = $unmunged_value;
+ $self->{'values'}->{"$column_name"} = $unmunged_value;
}
$ret->as_array( 1, "The new value has been set." );
return ( $ret->return_value );
@@ -814,7 +855,7 @@
return (1);
}
-=head2 truncate_value KEY VALUE
+=head2 truncate_value COLUMN VALUE
Truncate a value that's about to be set so that it will fit inside the
database' s idea of how big the column is.
@@ -826,19 +867,19 @@
sub truncate_value {
my $self = shift;
- my $key = shift;
+ my $column_name = shift;
my $value = shift;
# We don't need to truncate empty things.
return undef unless ( defined($value) );
- my $metadata = $self->_class_accessible->{$key};
+ my $column = $self->column($column_name);
my $truncate_to;
- if ( $metadata->{'length'} && !$metadata->{'is_numeric'} ) {
- $truncate_to = $metadata->{'length'};
+ if ( $column->length && !$column->is_numeric ) {
+ $truncate_to = $column->length;
}
- elsif ( $metadata->{'type'} && $metadata->{'type'} =~ /char\((\d+)\)/ ) {
+ elsif ( $column->type && $column->type =~ /char\((\d+)\)/ ) {
$truncate_to = $1;
}
@@ -868,50 +909,6 @@
}
-=head2 _object
-
-_object takes a single column name and an array reference. It creates
-new object instance of class specified in _class_accessable structure
-and calls load_by_id on recently created object with the current
-column value as argument. It uses the array reference as the object
-constructor's arguments. Subclasses can override _object to insert
-custom access control or define default contructor arguments.
-
-Note that if you are using a C<schema> with a C<REFERENCES> field,
-this is unnecessary: the method to access the column's value will
-automatically turn it into the appropriate object.
-
-=cut
-
-sub _object {
- my $self = shift;
- return $self->__object(@_);
-}
-
-sub __object {
- my $self = shift;
- my %args = ( field => '', args => [], @_ );
-
- my $field = $args{'field'};
- my $class = $self->_accessible( $field, 'object' );
-
- # Globs magic to be sure that we call 'eval "require $class"' only once
- # because eval is quite slow -- cubic at acronis.ru
- no strict qw( refs );
- my $vglob = ${ $class . '::' }{'VERSION'};
- unless ( $vglob && *$vglob{'SCALAR'} ) {
- eval "require $class";
- die "Couldn't use $class: $@" if ($@);
- unless ( $vglob && *$vglob{'SCALAR'} ) {
- *{ $class . "::VERSION" } = '-1, By DBIx::SerchBuilder';
- }
- }
-
- my $object = $class->new( @{ $args{'args'} } );
- $object->load_by_id( $self->__value($field) );
- return $object;
-}
-
# load should do a bit of overloading
# if we call it with only one argument, we're trying to load by reference.
# if we call it with a passel of arguments, we're trying to load by value
@@ -928,7 +925,6 @@
sub load {
my $self = shift;
- # my ($package, $filename, $line) = caller;
return $self->load_by_id(@_);
}
@@ -948,7 +944,7 @@
return ( $self->load_by_cols( $col => $val ) );
}
-=head2 loadbycols
+=head2 load_by_cols
Takes a hash of columns and values. Loads the first record that matches all
keys.
@@ -984,13 +980,9 @@
}
else {
push @phrases, "($key IS NULL OR $key = ?)";
- my $meta = $self->_class_accessible->{$key};
- $meta->{'type'} ||= '';
+ my $column = $self->column($key);
- # TODO: type checking should be done in generic way
- if ( $meta->{'is_numeric'}
- || $meta->{'type'}
- =~ /INT|NUMERIC|DECIMAL|REAL|DOUBLE|FLOAT/i )
+ if ( $column->is_numeric)
{
push @bind, 0;
}
@@ -1008,7 +1000,7 @@
return ( $self->_load_from_sql( $QueryString, @bind ) );
}
-=head2 loadbyid
+=head2 load_by_id
Loads a record by its primary key. Your record class must define a single primary key column.
@@ -1112,29 +1104,30 @@
my $self = shift;
my %attribs = @_;
- my ($key);
- foreach $key ( keys %attribs ) {
-
- if ( $self->_accessible( $key, 'record-write' ) ) {
- $attribs{$key} = $attribs{$key}->id
- if UNIVERSAL::isa( $attribs{$key}, 'Jifty::DBI::Record' );
+ foreach my $column_name ( keys %attribs ) {
+ my $column = $self->column($column_name);
+ unless ($column) {
+ die "$column_name isn't a column we know about"
+ }
+ if ( $column->readable and $column->refers_to_record ) {
+ $attribs{$column_name} = $attribs{$column_name}->id
+ if UNIVERSAL::isa( $attribs{$column_name}, 'Jifty::DBI::Record' );
}
#Truncate things that are too long for their datatypes
- $attribs{$key} = $self->truncate_value( $key => $attribs{$key} );
+ $attribs{$column_name} = $self->truncate_value( $column_name => $attribs{$column_name} );
}
unless ( $self->_handle->knows_blobs ) {
-
# Support for databases which don't deal with LOBs automatically
- my $ca = $self->_class_accessible();
- foreach $key ( keys %attribs ) {
- if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i )
+ foreach my $column_name ( keys %attribs ) {
+ my $column = $self->column($column_name);
+ if ( $column->type =~ /^(text|longtext|clob|blob|lob)$/i )
{
- my $bhash = $self->_handle->blob_params( $key,
- $ca->{$key}->{'type'} );
- $bhash->{'value'} = $attribs{$key};
- $attribs{$key} = $bhash;
+ my $bhash = $self->_handle->blob_params( $column_name,
+ $column->type );
+ $bhash->{'value'} = $attribs{$column_name};
+ $attribs{$column_name} = $bhash;
}
}
}
More information about the Rt-commit
mailing list