From: matthewt <matthewt@bd8105ee-0ff8-0310-8827-fb3f25b6796d>
Date: Thu, 26 Jul 2007 22:32:41 +0000 (+0000)
Subject: latest updates
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=92c65c8fc3f97cb2f735993a95fec1370f81bb9f;p=p5sagit%2FDevel-Declare.git

latest updates

git-svn-id: http://dev.catalyst.perl.org/repos/bast/trunk/Devel-Declare@3605 bd8105ee-0ff8-0310-8827-fb3f25b6796d
---

diff --git a/Makefile.PL b/Makefile.PL
index 09df2f6..e2aec53 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,6 +3,7 @@ use inc::Module::Install 0.67;
 name 'Devel-Declare';
 all_from 'lib/Devel/Declare.pm';
 
+requires 'Scalar::Util';
 build_requires 'Test::More';
 
 WriteMakefile(
diff --git a/lib/Devel/Declare.pm b/lib/Devel/Declare.pm
index 707f3e1..db54af1 100644
--- a/lib/Devel/Declare.pm
+++ b/lib/Devel/Declare.pm
@@ -15,6 +15,7 @@ use constant DECLARE_PACKAGE => 8+1; # name implicit
 
 use vars qw(%declarators %declarator_handlers);
 use base qw(DynaLoader);
+use Scalar::Util 'set_prototype';
 
 bootstrap Devel::Declare;
 
@@ -111,6 +112,35 @@ sub done_declare {
   }
 }
 
+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 -