[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