[Jifty-commit] r2568 - in Jifty-DBI/branches/od: . t

jifty-commit at lists.jifty.org jifty-commit at lists.jifty.org
Fri Jan 26 02:44:26 EST 2007


Author: clkao
Date: Fri Jan 26 02:44:26 2007
New Revision: 2568

Modified:
   Jifty-DBI/branches/od/   (props changed)
   Jifty-DBI/branches/od/Makefile.PL
   Jifty-DBI/branches/od/lib/Jifty/DBI/Record.pm
   Jifty-DBI/branches/od/lib/Jifty/DBI/Schema.pm
   Jifty-DBI/branches/od/t/01records.t
   Jifty-DBI/branches/od/t/12prefetch.t

Log:
 r15544 at ubuntu:  clkao | 2007-01-26 13:20:03 +0800
 od-ify jifty::dbi
 r15549 at ubuntu:  clkao | 2007-01-26 14:42:43 +0800
  r15548 at ubuntu (orig r2566):  clkao | 2007-01-26 14:42:17 +0800
  Modernize tests to use Jifty::DBI::Record schema {...} for schema.
 
 r15550 at ubuntu:  clkao | 2007-01-26 15:39:37 +0800
 mostly working except refers_to.
 r15551 at ubuntu:  clkao | 2007-01-26 15:40:35 +0800
 requires object::declare.


Modified: Jifty-DBI/branches/od/Makefile.PL
==============================================================================
--- Jifty-DBI/branches/od/Makefile.PL	(original)
+++ Jifty-DBI/branches/od/Makefile.PL	Fri Jan 26 02:44:26 2007
@@ -17,6 +17,7 @@
 requires('Encode'  => 2.10);
 requires('Exporter::Lite');
 requires('Lingua::EN::Inflect');
+requires('Object::Declare');
 requires('UNIVERSAL::require');
 build_requires('Test::More' => 0.52);
 build_requires('DBD::SQLite');

Modified: Jifty-DBI/branches/od/lib/Jifty/DBI/Record.pm
==============================================================================
--- Jifty-DBI/branches/od/lib/Jifty/DBI/Record.pm	(original)
+++ Jifty-DBI/branches/od/lib/Jifty/DBI/Record.pm	Fri Jan 26 02:44:26 2007
@@ -138,7 +138,6 @@
     my $self        = 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();
@@ -381,7 +380,6 @@
     my $self = shift;
     my $name = lc( shift || '' );
     my $col = $self->COLUMNS;
-
     return undef unless $col && exists $col->{$name};
     return $col->{$name};
 
@@ -1166,6 +1164,7 @@
 
 sub refers_to {
     my $class = shift;
+    die 'broken';
     return ( Jifty::DBI::Schema::Trait->new(refers_to => $class), @_ );
 }
 

Modified: Jifty-DBI/branches/od/lib/Jifty/DBI/Schema.pm
==============================================================================
--- Jifty-DBI/branches/od/lib/Jifty/DBI/Schema.pm	(original)
+++ Jifty-DBI/branches/od/lib/Jifty/DBI/Schema.pm	Fri Jan 26 02:44:26 2007
@@ -41,9 +41,32 @@
 =cut
 
 use Carp qw/croak carp/;
+use Scalar::Defer;
+use Object::Declare (
+    mapping => {
+        column => sub { Jifty::DBI::Column->new({@_}) } ,
+    },
+    aliases => {
+        default_value => 'default',
+        available   => 'available_values',
+        valid       => 'valid_values',
+        render      => 'render_as',
+        order       => 'sort_order',
+        max_length  => 'length',
+        filters     => 'input_filters',
+    },
+    copula  => {
+        is      => '',
+        are     => '',
+        as      => '',
+        by      => '',
+        ajax    => 'ajax_',
+    }
+);
 use Exporter::Lite;
-our @EXPORT
-    = qw(column type default literal validator autocompleted immutable unreadable length distinct mandatory not_null sort_order valid_values label hints render_as render since input_filters output_filters filters virtual is as by are on schema indexed valid order);
+use Class::Data::Inheritable;
+
+our @EXPORT = qw( defer lazy column schema );
 
 our $SCHEMA;
 our $SORT_ORDERS = {};
@@ -68,41 +91,83 @@
 
 sub schema (&) {
     my $code = shift;
-
-    my $from = (caller)[0];
+    my $from = caller;
 
     my $new_code = sub {
-        $code->();
-
-        # Unimport all our symbols from the calling package.
-        foreach my $sym (@EXPORT) {
-            no strict 'refs';
-            undef *{"$from\::$sym"}
-                if \&{"$from\::$sym"} == \&$sym;
-        }
-
-        # Then initialize all columns
-        foreach my $column (sort keys %{$from->COLUMNS||{}}) {
-            $from->_init_methods_for_column($from->COLUMNS->{$column});
-        }
+	no warnings 'redefine';
+	local *_ = sub { my $args = \@_; defer { _(@$args) } };
+	$from->_init_columns;
+
+	my @columns = &declare($code);
+
+	foreach my $column (@columns) {
+	    next if !ref($column);
+	    _init_column($column);
+	}
+
+	# XXX: merge superclasses' columns?
+
+	# Unimport all our symbols from the calling package.
+	foreach my $sym (@EXPORT) {
+	    no strict 'refs';
+	    undef *{"$from\::$sym"}
+		if \&{"$from\::$sym"} == \&$sym;
+	}
+	# Then initialize all columns
+	foreach my $column ( sort keys %{ $from->COLUMNS || {} } ) {
+	    $from->_init_methods_for_column( $from->COLUMNS->{$column} );
+	}
     };
 
-    return('-base' => $new_code);
+    return ('-base' => $new_code);
 }
 
-=head2 column
+use Hash::Merge ();
+
+no warnings 'uninitialized';
+use constant MERGE_PARAM_BEHAVIOUR => {
+    SCALAR => {
+            SCALAR => sub { length($_[1]) ? $_[1] : $_[0] },
+            ARRAY  => sub { [ @{$_[1]} ] },
+            HASH   => sub { $_[1] } },
+    ARRAY => {
+            SCALAR => sub { length($_[1]) ? $_[1] : $_[0] },
+            ARRAY  => sub { [ @{$_[1]} ] },
+            HASH   => sub { $_[1] } },
+    HASH => {
+            SCALAR => sub { length($_[1]) ? $_[1] : $_[0] },
+            ARRAY  => sub { [ @{$_[1]} ] },
+            HASH   => sub { Hash::Merge::_merge_hashes( $_[0], $_[1] ) } }
+};
+
+=head2 merge_params HASHREF HASHREF
+
+Takes two hashrefs. Merges them together and returns the merged hashref.
+
+    - Empty fields in subclasses don't override nonempty fields in superclass anymore.
+    - Arrays don't merge; e.g. if parent class's valid_values is [1,2,3,4], and
+      subclass's valid_values() is [1,2], they don't somehow become [1,2,3,4,1,2].
+
+BUG: This should either be a private routine or factored out into Jifty::Util
 
-Set forth the description of a column in the data store.
 
-Note: If the column uses 'refers_to' to reference another class then you 
-should not name the column ending in '_id' as it has special meaning.
 
 =cut
 
-sub column {
-    my $name = lc(shift);
+sub merge_params {
+    my $prev_behaviour = Hash::Merge::get_behavior();
+    Hash::Merge::specify_behavior( MERGE_PARAM_BEHAVIOUR, "merge_params" );
+    my $rv = Hash::Merge::merge(@_);
+    Hash::Merge::set_behavior( $prev_behaviour );
+    return $rv;
+}
+
 
-    my $from = (caller)[0];
+sub _init_column {
+    my $column = shift;
+    my $name   = $column->name;
+
+    my $from = (caller(2))[0];
     $from =~ s/::Schema//;
 
     croak "Base of schema class $from is not a Jifty::DBI::Record"
@@ -111,23 +176,17 @@
     croak "Illegal column definition for column $name in $from"
       if grep {not UNIVERSAL::isa($_, "Jifty::DBI::Schema::Trait")} @_;
 
-    $from->_init_columns;
-
+    $column->readable(!(delete $column->{unreadable}));
+    $column->writable(!(delete $column->{immutable}));
 
-    my @args = (
-        ! unreadable(),
-        ! immutable(),
-        ! virtual(),
-        type(''),
-        @_
-    );
+    # XXX: deprecated
+    $column->mandatory(1) if delete $column->{not_null};
 
-    my $column = Jifty::DBI::Column->new( { name => $name } );
     $column->sort_order($SORT_ORDERS->{$from}++);
 
-    $_->apply($column) for @args;
-
-    if ( my $refclass = $column->refers_to ) {
+    if (0) {
+#    if ( my $refclass = $column->refers_to ) {
+        my $refclass;
         $refclass->require();
         $column->type('integer') unless ( $column->type );
 
@@ -142,7 +201,7 @@
                 # alias_for_column in a couple places
                 $virtual_column->name( $name );
                 $virtual_column->aliased_as($aliased_as);
-                $_->apply($virtual_column) for @args;
+#                $_->apply($virtual_column) for @args;
                 $column->refers_to(undef);
                 $virtual_column->alias_for_column($name);
                 $from->_init_methods_for_column($virtual_column);
@@ -167,12 +226,12 @@
     # through the &schema wrapper, so we defer initialization here
     # to not upset column names such as "label" and "type".
     # (We may not *have* a caller(1) if the user is executing a .pm file.)
-    my $caller1 = caller(1);
-    return if defined $caller1 && $caller1 eq __PACKAGE__;
-
-    $from->_init_methods_for_column($column)
 }
 
+1;
+
+__END__
+
 =head2 refers_to
 
 Indicates that the column references an object or a collection of objects in another
@@ -209,59 +268,28 @@
 databases.  For example blobs have different names between
 mysql and postgres.
 
-=cut
-
-sub type {
-    _list( type => @_ );
-}
-
 =head2 default
 
 Give a default value for the column.  Correct usage is C<default is
 'foo'>.
 
-=cut
-
-sub default {
-    _list( default => @_ );
-}
-
 =head2 literal
 
 Used for default values, to connote that they should not be quoted
 before being supplied as the default value for the column.  Correct
 usage is C<default is literal 'now()'>.
 
-=cut
-
-sub literal($) {
-    my $value = shift;
-    return \$value;
-}
-
 =head2 validator
 
 Defines a subroutine which returns a true value only for valid values
 this column can have.  Correct usage is C<validator is \&foo>.
 
-=cut
-
-sub validator {
-    _list( validator => @_ );
-}
-
 =head2 immutable
 
 States that this column is not writable.  This is useful for
 properties that are set at creation time but not modifiable
 thereafter, like 'created by'.  Correct usage is C<is immutable>.
 
-=cut
-
-sub immutable {
-    _item( writable => 0, @_ );
-}
-
 =head2 unreadable
 
 States that this column is not directly readable by the application
@@ -269,12 +297,6 @@
 the like.  The data is still accessible via C<< $record->_value('') >>.
 Correct usage is C<is unreadable>.
 
-=cut
-
-sub unreadable {
-    _item( readable => 0, @_ );
-}
-
 =head2 length
 
 Sets a maximum length to store in the database; values longer than
@@ -282,46 +304,21 @@
 L<Jifty::DBI::Filter::Truncate>.  Note that this is in B<bytes>, not
 B<characters>.  Correct usage is C<length is 42>.
 
-=cut
-
-sub length {
-    _list( length => @_ );
-}
-
 =head2 mandatory
 
 Mark as a required column.  May be used for generating user
 interfaces.  Correct usage is C<is mandatory>.
 
-=cut
-
-sub mandatory {
-    _item( mandatory => 1, @_ );
-}
-
 =head2 not_null
 
 Same as L</mandatory>.  This is deprecated.  Currect usage would be
 C<is not_null>.
 
-=cut
-
-sub not_null {
-    carp "'is not_null' is deprecated in favor of 'is mandatory'";
-    _item( mandatory => 1, @_ );
-}
-
 =head2 autocompleted
 
 Mark as an autocompleted column.  May be used for generating user
 interfaces.  Correct usage is C<is autocompleted>.
 
-=cut
-
-sub autocompleted {
-    _item( autocompleted => 1, @_ );
-}
-
 =head2 distinct
 
 Declares that a column should only have distinct values.  This
@@ -331,56 +328,26 @@
 columns implemented in L<DBIx::DBSchema> at this time.  
 Correct usage is C<is distinct>.
 
-=cut
-
-sub distinct {
-    _item( distinct => 1, @_ );
-}
-
 =head2 virtual
 
 Declares that a column is not backed by an actual column in the
 database, but is instead computed on-the-fly.
 
-=cut
-
-sub virtual {
-    _item( virtual => 1, @_ );
-}
-
-
 =head2 sort_order
 
 Declares an integer sort value for this column. By default, Jifty will sort
 columns in the order they are defined.
 
-=cut
-
-sub sort_order {
-    _item ( sort_order => (shift @_ || 0));
-}
-
 =head2 order
 
 Alias for C<sort_order>.
 
-=cut
-
-sub order { sort_order(@_) }
-
-
 =head2 input_filters
 
 Sets a list of input filters on the data.  Correct usage is
 C<input_filters are 'Jifty::DBI::Filter::DateTime'>.  See
 L<Jifty::DBI::Filter>.
 
-=cut
-
-sub input_filters {
-    _list( input_filters => @_ );
-}
-
 =head2 output_filters
 
 Sets a list of output filters on the data.  Correct usage is
@@ -388,12 +355,6 @@
 L<Jifty::DBI::Filter>.  You usually don't need to set this, as the
 output filters default to the input filters in reverse order.
 
-=cut
-
-sub output_filters {
-    _list( output_filters => @_ );
-}
-
 =head2 filters
 
 Sets a list of filters on the data.  These are applied when reading
@@ -402,23 +363,11 @@
 actuality, this is the exact same as L</input_filters>, since output
 filters default to the input filters, reversed.
 
-=cut
-
-sub filters {
-    _list( input_filters => @_ );
-}
-
 =head2 since
 
 What application version this column was last changed.  Correct usage
 is C<since '0.1.5'>.
 
-=cut
-
-sub since {
-    _list( since => @_ );
-}
-
 =head2 valid_values
 
 A list of valid values for this column. Jifty will use this to
@@ -434,45 +383,21 @@
   { display => 'Blue', value => 'blue' },
   { display => 'Red', value => 'red' }
 
-=cut
-
-sub valid_values {
-    _list( valid_values => @_ );
-}
-
 =head2 valid
 
 Alias for C<valid_values>.
 
-=cut
-
-sub valid {
-    _list( valid_values => @_ );
-}
-
 =head2 label
 
 Designates a human-readable label for the column, for use in user
 interfaces.  Correct usage is C<label is 'Your foo value'>.
 
-=cut
-
-sub label {
-    _list( label => @_ );
-}
-
 =head2 hints
 
 A sentence or two to display in long-form user interfaces about what
 might go in this column.  Correct usage is C<hints is 'Used by the
 frobnicator to do strange things'>.
 
-=cut
-
-sub hints {
-    _list( hints => @_ );
-}
-
 =head2 render_as
 
 Used in user interface generation to know how to render the column.
@@ -516,108 +441,15 @@
 If these don't meet your needs, you can write your own subclass of
 L<Jifty::Web::Form::Field>. See the documentation for that module.
 
-=cut
-
-sub render_as {
-    _list( render_as => @_ );
-}
-
 =head2 render
 
 Alias for C<render_as>.
 
-=cut
-
-sub render {
-    _list( render_as => @_ );
-}
-
 =head2 indexed
 
 An index will be built on this column
 Correct usage is C<is indexed>
 
-=cut
-
-sub indexed {
-    _list( indexed => 1, @_ );
-}
-
-=head2 by
-
-Helper method to improve readability.
-
-=cut
-
-sub by {
-    _list( by => @_ );
-}
-
-=head2 is
-
-Helper method to improve readability.
-
-=cut
-
-sub is {
-    my $thing = shift;
-    ref $thing eq "ARRAY" ? ( @{$thing}, @_ ) : ($thing, @_);
-}
-
-=head2 as
-
-Helper method to improve readability.
-
-=cut
-
-sub as {
-    my $thing = shift;
-    ref $thing eq "ARRAY" ? ( @{$thing}, @_ ) : ($thing, @_);
-}
-
-=head2 are
-
-Helper method to improve readability.
-
-=cut
-
-sub are {
-    my $ref = [];
-    push @{$ref}, shift @_ while @_ and not UNIVERSAL::isa($_[0], "Jifty::DBI::Schema::Trait");
-    return( $ref, @_ );
-}
-
-=head2 on
-
-Helper method to improve readability.
-
-=cut
-
-sub on {
-    _list( self => shift );
-}
-
-sub _list {
-    defined wantarray
-        or croak("Cannot add traits in void context -- check for misspelled preceding comma as a semicolon or missing use statements for models you refer_to.");
-
-    wantarray
-        or croak("Cannot call list traits in scalar context -- check for unneccessary 'is'");
-    _trait(@_);
-}
-
-sub _item {
-    defined wantarray
-        or croak("Cannot add traits in void context -- check for misspelled preceding comma as a semicolon");
-
-    _trait(@_);
-}
-
-sub _trait {
-    my @trait;
-    push @trait, shift @_ while @_ and not UNIVERSAL::isa($_[0], "Jifty::DBI::Schema::Trait");
-    return wantarray ? (Jifty::DBI::Schema::Trait->new(@trait), @_) : Jifty::DBI::Schema::Trait->new(@trait);
-}
 
 =head1 EXAMPLE
 
@@ -634,32 +466,4 @@
 
 =cut
 
-package Jifty::DBI::Schema::Trait;
-
-use overload "!" => \&negation;
-use Carp qw/croak/;
-
-sub new {
-    my $class = shift;
-    return bless [@_], $class;
-}
-
-sub apply {
-    my $self = shift;
-    my ($column) = @_;
-
-    my ($method, $argument) = @{$self};
-
-    croak("Illegal Jifty::DBI::Schema property '$method'")
-      unless $column->can($method);
-
-    $column->$method($argument);
-}
-
-sub negation {
-    my $self = shift;
-    my ($trait, @rest) = @{$self};
-    return (ref $self)->new($trait, map {not $_} @rest);
-}
-
 1;

Modified: Jifty-DBI/branches/od/t/01records.t
==============================================================================
--- Jifty-DBI/branches/od/t/01records.t	(original)
+++ Jifty-DBI/branches/od/t/01records.t	Fri Jan 26 02:44:26 2007
@@ -38,7 +38,6 @@
         is( $rec->_accessible('id' => 'write'), 0, 'id is not accessible for write' );
         is( $rec->_accessible('id'), undef, "any column is not accessible in undefined mode" );
         is( $rec->_accessible('unexpected_column' => 'read'), undef, "column doesn't exist and can't be accessible for read" );
-
         is_deeply( [sort($rec->readable_attributes)], [sort qw(address employee_id id name phone)], 'readable attributes' );
         is_deeply( [sort($rec->writable_attributes)], [sort qw(address employee_id name phone)], 'writable attributes' );
 
@@ -282,7 +281,7 @@
   type is 'varchar(14)';
 
 column phone =>
-  type is 'varchar(18)',
+  type is 'varchar(18)';
 
 column address =>
   type is 'varchar(50)',

Modified: Jifty-DBI/branches/od/t/12prefetch.t
==============================================================================
--- Jifty-DBI/branches/od/t/12prefetch.t	(original)
+++ Jifty-DBI/branches/od/t/12prefetch.t	Fri Jan 26 02:44:26 2007
@@ -183,7 +183,7 @@
 BEGIN {
     use Jifty::DBI::Schema;
     use Jifty::DBI::Record schema {
-    column name => type 'varchar';
+    column name => type is 'varchar';
     column phones => refers_to TestApp::PhoneCollection by 'employee';
     }
 }
@@ -195,7 +195,7 @@
     use Jifty::DBI::Schema;
     use Jifty::DBI::Record schema {
     column employee => refers_to TestApp::Employee;
-    column phone    => type 'varchar';
+    column phone    => type is 'varchar';
     }
 }
 


More information about the Jifty-commit mailing list