[Rt-commit] r5621 - in Object-Declare: lib/Object t

[audreyt at bestpractical.com]

Author: audreyt
Date: Thu Jul 20 11:42:45 2006
New Revision: 5621

Modified:
   Object-Declare/Changes
   Object-Declare/lib/Object/Declare.pm
   Object-Declare/t/01-basic.t

Log:
* This be 0.09.
* The "mapping" interface now accepts arbitrary code reference as the
  builder function, in addition to class names to call ->new to.

Modified: Object-Declare/Changes
==============================================================================
--- Object-Declare/Changes	(original)
+++ Object-Declare/Changes	Thu Jul 20 11:42:45 2006
@@ -1,3 +1,8 @@
+[Changes for 0.09 - 2006-07-18]
+
+* The "mapping" interface now accepts arbitrary code reference as the
+  builder function, in addition to class names to call ->new to.
+
 [Changes for 0.08 - 2006-07-18]
 
 * Added lots of documentation and comments.

Modified: Object-Declare/lib/Object/Declare.pm
==============================================================================
--- Object-Declare/lib/Object/Declare.pm	(original)
+++ Object-Declare/lib/Object/Declare.pm	Thu Jul 20 11:42:45 2006
@@ -4,19 +4,25 @@
 use strict;
 use warnings;
 
-$Object::Declare::VERSION = '0.08';
+$Object::Declare::VERSION = '0.09';
 
-use Carp;
 use Sub::Override;
 
 sub import {
     my $class       = shift;
     my %args        = ((@_ and ref($_[0])) ? (mapping => $_[0]) : @_) or return; 
     my $from        = caller;
+
     my $mapping     = $args{mapping} or return;
     my $declarator  = $args{declarator} || ['declare'];
     my $copula      = $args{copula}     || ['is', 'are'];
 
+    # Both declarator and copula can contain more than one entries;
+    # normalize into an arrayref if we only have on entry.
+    $mapping    = [$mapping]    unless ref($mapping);
+    $declarator = [$declarator] unless ref($declarator);
+    $copula     = [$copula]     unless ref($copula);
+
     if (ref($mapping) eq 'ARRAY') {
         # rewrite "MyApp::Foo" into simply "foo"
         $mapping = {
@@ -28,10 +34,14 @@
         };
     }
 
-    # Both declarator and copula can contain more than one entries;
-    # normalize into an arrayref if we only have on entry.
-    $declarator = [$declarator] unless ref($declarator) eq 'ARRAY';
-    $copula     = [$copula]     unless ref($copula) eq 'ARRAY';
+    # Convert mapping targets into instantiation closures
+    if (ref($mapping) eq 'HASH') {
+        foreach my $key (keys %$mapping) {
+            my $val = $mapping->{$key};
+            next if ref($val); # already a callback, don't bother
+            $mapping->{$key} = sub { scalar($val->new(@_)) };
+        }
+    }
 
     # Install declarator functions into caller's package, remembering
     # the mapping and copula set for this declarator.
@@ -88,8 +98,8 @@
     }
 
     # Now install the collector symbols from class mappings 
-    while (my ($sym, $class) = each %$mapping) {
-        $replace->("$from\::$sym" => _make_object($class => \@objects));
+    while (my ($sym, $build) = each %$mapping) {
+        $replace->("$from\::$sym" => _make_object($build => \@objects));
     }
 
     # Let's play Katamari!
@@ -116,11 +126,11 @@
 
 # Make a star from the Katamari!
 sub _make_object {
-    my ($class, $schema) = @_;
+    my ($build, $schema) = @_;
 
     return sub {
         my $name = shift;
-        push @$schema, $name => scalar $class->new(map { $_->unroll } @_);
+        push @$schema, $name => $build->(map { $_->unroll } @_);
     };
 }
 
@@ -187,11 +197,13 @@
 (I<copula>), and the table of named classes to declare (I<mapping>):
 
     use Object::Declare
-        declarator  => 'declare',       # this is the default
+        declarator  => 'declare',       # is the default
         copula      => ['is', 'are'],   # this is the default
         mapping     => {
-            column => 'MyApp::Column',
-            param  => 'MyApp::Param',
+            column => 'MyApp::Column',  # class name to call ->new to
+            param  => sub {             # arbitrary coderef also works
+                bless(\@_, 'MyApp::Param');
+            },
         };
 
 After the declarator block finishes execution, all helper functions are

Modified: Object-Declare/t/01-basic.t
==============================================================================
--- Object-Declare/t/01-basic.t	(original)
+++ Object-Declare/t/01-basic.t	Thu Jul 20 11:42:45 2006
@@ -1,6 +1,9 @@
 use strict;
 use Test::More tests => 3, import => ['is_deeply'];
-use ok 'Object::Declare' => ['MyApp::Column'];
+use ok 'Object::Declare' => {
+    column  => 'MyApp::Column',
+    alt_col => sub { return { alt => 1, @_ } }
+};
 
 sub MyApp::Column::new { shift; return { @_ } }
 
@@ -12,7 +15,7 @@
         field2 are 'XXX', 'XXX',
         is field3;
 
-    column y =>
+    alt_col y =>
         field1 is 'yyy',
         field2 is 'YYY';
 } }
@@ -30,6 +33,7 @@
     y => {
             'field1' => 'yyy',
             'field2' => 'YYY',
+            'alt'    => 1,
             },
 ], 'object declared correctly (list context)');
 
@@ -46,6 +50,7 @@
     y => {
             'field1' => 'yyy',
             'field2' => 'YYY',
+            'alt'    => 1,
             },
 }, 'object declared correctly (scalar context)');