[Bast-commits] r3605 - in trunk/Devel-Declare: . lib/Devel

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2007-07-26 23:32:41 +0100 (Thu, 26 Jul 2007)
New Revision: 3605

Modified:
   trunk/Devel-Declare/Makefile.PL
   trunk/Devel-Declare/lib/Devel/Declare.pm
Log:
latest updates

Modified: trunk/Devel-Declare/Makefile.PL
===================================================================
--- trunk/Devel-Declare/Makefile.PL	2007-07-26 21:31:08 UTC (rev 3604)
+++ trunk/Devel-Declare/Makefile.PL	2007-07-26 22:32:41 UTC (rev 3605)
@@ -3,6 +3,7 @@
 name 'Devel-Declare';
 all_from 'lib/Devel/Declare.pm';
 
+requires 'Scalar::Util';
 build_requires 'Test::More';
 
 WriteMakefile(

Modified: trunk/Devel-Declare/lib/Devel/Declare.pm
===================================================================
--- trunk/Devel-Declare/lib/Devel/Declare.pm	2007-07-26 21:31:08 UTC (rev 3604)
+++ trunk/Devel-Declare/lib/Devel/Declare.pm	2007-07-26 22:32:41 UTC (rev 3605)
@@ -15,6 +15,7 @@
 
 use vars qw(%declarators %declarator_handlers);
 use base qw(DynaLoader);
+use Scalar::Util 'set_prototype';
 
 bootstrap Devel::Declare;
 
@@ -111,6 +112,35 @@
   }
 }
 
+sub build_sub_installer {
+  my ($class, $pack, $name, $proto) = @_;
+  return eval "
+    package ${pack};
+    my \$body;
+    sub ${name} (${proto}) :lvalue {\n"
+    .'$body->(@_);
+    };
+    sub { ($body) = @_; };';
+}
+
+sub setup_declarators {
+  my ($class, $pack, $to_setup) = @_;
+  die "${class}->setup_declarator(\$pack, \\\%to_setup)"
+    unless defined($pack) && ref($to_setup eq 'HASH');
+  foreach my $name (keys %$to_setup) {
+    my $info = $to_setup->{$name};
+    my $flags = $info->{flags} || DECLARE_NAME;
+    my $run = $info->{run};
+    my $compile = $info->{compile};
+    my $proto = $info->{proto} || '&';
+    my $sub_proto = $proto;
+    # make all args optional to enable lvalue for DECLARE_NONE
+    $sub_proto =~ s/;//; $sub_proto = ';'.$sub_proto;
+    my $installer = $class->build_sub_installer($pack, $name, $proto);
+    # XXX UNCLEAN 
+  }
+}
+
 =head1 NAME
 
 Devel::Declare -