From fb375fa217e3302a27254932826b77d44be0bd96 Mon Sep 17 00:00:00 2001 From: Rhesa Rozendaal Date: Thu, 23 Oct 2008 00:01:46 +0200 Subject: [PATCH] switched to using Devel::Declare::Context::Simple. --- lib/MooseX/Declare.pm | 142 +++++++++++-------------------------------------- 1 files changed, 32 insertions(+), 110 deletions(-) diff --git a/lib/MooseX/Declare.pm b/lib/MooseX/Declare.pm index 93932cd..1e6390a 100644 --- a/lib/MooseX/Declare.pm +++ b/lib/MooseX/Declare.pm @@ -5,12 +5,12 @@ package MooseX::Declare; use Devel::Declare (); use Moose::Meta::Class; -use B::Hooks::EndOfScope; use MooseX::Method::Signatures; +use base 'Devel::Declare::Context::Simple'; our $VERSION = '0.01_01'; -our ($Declarator, $Offset, @Roles); +our (@Roles); sub import { my ($class, $type) = @_; @@ -47,45 +47,22 @@ sub import { MooseX::Method::Signatures->setup_for($caller) } -sub skip_declarator { - $Offset += Devel::Declare::toke_move_past_token($Offset); -} - -sub skipspace { - $Offset += Devel::Declare::toke_skipspace($Offset); -} - -sub strip_name { - skipspace; - - if (my $len = Devel::Declare::toke_scan_word($Offset, 1)) { - my $linestr = Devel::Declare::get_linestr(); - my $name = substr($linestr, $Offset, $len); - substr($linestr, $Offset, $len) = ''; - Devel::Declare::set_linestr($linestr); - return $name; - } - - skipspace; - - return; -} - sub strip_options { - skipspace; + my $self = shift; + $self->skipspace; my %ret; my $linestr = Devel::Declare::get_linestr(); - while (substr($linestr, $Offset, 1) ne '{') { - my $len = Devel::Declare::toke_scan_word($Offset, 0); + while (substr($linestr, $self->offset, 1) ne '{') { + my $len = Devel::Declare::toke_scan_word($self->offset, 0); if (!$len) { die 'expected option name'; } $linestr = Devel::Declare::get_linestr(); - my $key = substr($linestr, $Offset, $len); - substr($linestr, $Offset, $len) = ''; + my $key = substr($linestr, $self->offset, $len); + substr($linestr, $self->offset, $len) = ''; if ($key !~ /^(extends|with|is)$/) { die "unknown option name '${key}'"; @@ -93,23 +70,23 @@ sub strip_options { Devel::Declare::set_linestr($linestr); - skipspace; + $self->skipspace; - $len = Devel::Declare::toke_scan_word($Offset, 1); + $len = Devel::Declare::toke_scan_word($self->offset, 1); if (!$len) { die 'expected option value'; } $linestr = Devel::Declare::get_linestr(); - my $val = substr($linestr, $Offset, $len); - substr($linestr, $Offset, $len) = ''; + my $val = substr($linestr, $self->offset, $len); + substr($linestr, $self->offset, $len) = ''; $ret{$key} ||= []; push @{ $ret{$key} }, $val; Devel::Declare::set_linestr($linestr); - skipspace; + $self->skipspace; } return { map { @@ -120,49 +97,6 @@ sub strip_options { } keys %ret }; } -sub strip_proto { - skipspace; - - my $linestr = Devel::Declare::get_linestr(); - if (substr($linestr, $Offset, 1) eq '(') { - my $length = Devel::Declare::toke_scan_str($Offset); - my $proto = Devel::Declare::get_lex_stuff(); - Devel::Declare::clear_lex_stuff(); - $linestr = Devel::Declare::get_linestr(); - substr($linestr, $Offset, $length) = ''; - Devel::Declare::set_linestr($linestr); - return $proto; - } - - return; -} - -sub inject_if_block { - my $inject = shift; - my $inject_before = shift || ''; - - skipspace; - - my $linestr = Devel::Declare::get_linestr; - if (substr($linestr, $Offset, 1) eq '{') { - substr($linestr, $Offset+1, 0) = $inject; - substr($linestr, $Offset, 0) = $inject_before; - Devel::Declare::set_linestr($linestr); - } -} - -sub scope_injector_call { - my ($inject) = @_; - $inject ||= ''; - - return "BEGIN { MooseX::Declare::inject_scope('${inject}') }; "; -} - -sub shadow { - my $pack = Devel::Declare::get_curstash_name; - Devel::Declare::shadow_sub("${pack}::${Declarator}", $_[0]); -} - sub options_unwrap { my ($options) = @_; my $ret = ''; @@ -183,41 +117,41 @@ sub options_unwrap { } sub modifier_parser { - local ($Declarator, $Offset) = @_; + my $self = __PACKAGE__->new->init(@_); - skip_declarator; + $self->skip_declarator; - my $name = strip_name; + my $name = $self->strip_name; die 'method name expected' unless defined $name; - my $proto = strip_proto || ''; + my $proto = $self->strip_proto || ''; $proto = '$orig: $self' . (length $proto ? ", ${proto}" : '') - if $Declarator eq 'around'; + if $self->declarator eq 'around'; - inject_if_block( scope_injector_call('};'), "{ method (${proto})" ); + $self->inject_if_block( $self->scope_injector_call('};'), "{ method (${proto})" ); - my $meth = Moose->can($Declarator); - shadow(sub (&) { + my $meth = Moose->can($self->declarator); + $self->shadow(sub (&) { my $class = caller(); $meth->($class, $name, shift->()->body); }); } sub class_parser { - local ($Declarator, $Offset) = @_; + my $self = __PACKAGE__->new->init(@_); - skip_declarator; + $self->skip_declarator; - my $name = strip_name; - my $options = strip_options; + my $name = $self->strip_name; + my $options = $self->strip_options; my ($package, $anon); if (defined $name) { $package = $name; - my $stash = Devel::Declare::get_curstash_name(); + my $stash = $self->get_curstash_name; $package = join('::', $stash, $name) unless $stash eq 'main'; } @@ -229,12 +163,12 @@ sub class_parser { my $inject = qq/package ${package}; use MooseX::Declare 'inner'; /; my $inject_after = ''; - if ($Declarator eq 'class') { + if ($self->declarator eq 'class') { $inject .= q/use Moose qw{extends has inner super confess blessed};/; $inject_after .= "${package}->meta->make_immutable;" unless exists $options->{is}->{mutable}; } - elsif ($Declarator eq 'role') { + elsif ($self->declarator eq 'role') { $inject .= q/use Moose::Role qw{requires excludes has extends super inner confess blessed};/; } else { die } @@ -243,10 +177,10 @@ sub class_parser { $inject .= options_unwrap($options); if (defined $name) { - $inject .= scope_injector_call($inject_after); + $inject .= $self->scope_injector_call($inject_after); } - inject_if_block($inject); + $self->inject_if_block($inject); my $create_class = sub { local @Roles = (); @@ -256,25 +190,13 @@ sub class_parser { }; if (defined $name) { - shadow(sub (&) { $create_class->(@_); return $name; }); + $self->shadow(sub (&) { $create_class->(@_); return $name; }); } else { - shadow(sub (&) { $create_class->(@_); return $anon; }); + $self->shadow(sub (&) { $create_class->(@_); return $anon; }); } } -sub inject_scope { - my ($inject) = @_; - - on_scope_end { - my $linestr = Devel::Declare::get_linestr(); - return unless defined $linestr; - my $offset = Devel::Declare::get_linestr_offset(); - substr($linestr, $offset, 0) = ';' . $inject; - Devel::Declare::set_linestr($linestr); - }; -} - 1; __END__ -- 1.5.4.3