[Bps-public-commit] r11470 - in SVN-PropDB: bin

clkao at bestpractical.com clkao at bestpractical.com
Thu Apr 3 23:12:36 EDT 2008


Author: clkao
Date: Thu Apr  3 23:12:35 2008
New Revision: 11470

Modified:
   SVN-PropDB/bin/sd
   SVN-PropDB/lib/Prophet/CLI.pm
   SVN-PropDB/lib/Prophet/Record.pm

Log:
more cleanups.


Modified: SVN-PropDB/bin/sd
==============================================================================
--- SVN-PropDB/bin/sd	(original)
+++ SVN-PropDB/bin/sd	Thu Apr  3 23:12:35 2008
@@ -7,8 +7,7 @@
 
 
 package SVB::Record; # should probably be Prophet::App::Record
-use base qw/Prophet::Record Class::Data::Inheritable/;
-__PACKAGE__->mk_classdata(REFERENCES => {});
+use base qw/Prophet::Record/;
 
 package SVB::Model::Ticket;
 use base qw/SVB::Record/;

Modified: SVN-PropDB/lib/Prophet/CLI.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/CLI.pm	(original)
+++ SVN-PropDB/lib/Prophet/CLI.pm	Thu Apr  3 23:12:35 2008
@@ -191,7 +191,6 @@
     unless ( $regex = $cli->args->{regex} ) {
         die "Specify a regular expression and we'll search for records matching that regex";
     }
-
     my $record = $cli->_get_record;
     my $records = $record->collection_class->new( handle => $cli->handle, type => $cli->type );
     $records->matching(

Modified: SVN-PropDB/lib/Prophet/Record.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Record.pm	(original)
+++ SVN-PropDB/lib/Prophet/Record.pm	Thu Apr  3 23:12:35 2008
@@ -13,9 +13,10 @@
 
 =cut
 
-use base qw'Class::Accessor';
+use base qw'Class::Accessor Class::Data::Inheritable';
 
 __PACKAGE__->mk_accessors(qw'handle uuid type');
+__PACKAGE__->mk_classdata(REFERENCES => {});
 
 use Params::Validate;
 use Prophet::HistoryEntry;
@@ -37,7 +38,6 @@
     my $class = shift;
     my $self  = bless {}, $class;
     my $args  = ref($_[0]) ? $_[0] : { @_ };
-    Carp::cluck unless $args->{type};
     $args->{type} ||= $class->record_type;
     my %args  = validate( @{[%$args]}, { handle => 1, type => 1 } );
     $self->$_( $args{$_} ) for keys(%args);
@@ -46,24 +46,28 @@
 
 sub record_type { $_[0]->type }
 
-=head2 register_refers
+=head2 register_refers $accessor, $collection_class, by => $key_in_model
+
+Registers and create accessor in current class the associated
+collection C<$collection_class>, which refers to the current class by
+$key_in_model in the model class of $collection_class.
 
 =cut
 
 sub register_refers {
-    my ($class, $accessor, $model, @args) = @_;
+    my ($class, $accessor, $collection_class, @args) = @_;
     my %args = validate( @args, { by => 1 });
     no strict 'refs';
     *{$class."::$accessor"} = sub {
         my $self = shift;
-        my $collection = $model->new( handle => $self->handle, type => $model->record_class );
+        my $collection = $collection_class->new( handle => $self->handle, type => $collection_class->record_class );
         $collection->matching( sub { $_[0]->prop($args{by}) eq $self->uuid } );
         return $collection;
     };
     # XXX: add validater for $args{by} in $model->record_class
 
 
-    $class->REFERENCES->{$accessor} = { %args, type => $model->record_class };
+    $class->REFERENCES->{$accessor} = { %args, type => $collection_class->record_class };
 }
 
 



More information about the Bps-public-commit mailing list