[Bast-commits] r4935 - in
Devel-Declare/1.000/branches/context_object:
lib/Devel/Declare/Context lib/Devel/Declare/MethodInstaller t
rhesa at dev.catalyst.perl.org
rhesa at dev.catalyst.perl.org
Sat Oct 18 14:40:29 BST 2008
Author: rhesa
Date: 2008-10-18 14:40:29 +0100 (Sat, 18 Oct 2008)
New Revision: 4935
Modified:
Devel-Declare/1.000/branches/context_object/lib/Devel/Declare/Context/Simple.pm
Devel-Declare/1.000/branches/context_object/lib/Devel/Declare/MethodInstaller/Simple.pm
Devel-Declare/1.000/branches/context_object/t/methinstaller-simple.t
Log:
branches/context_object: reformatted with 2-space indent, and "if ("
Modified: Devel-Declare/1.000/branches/context_object/lib/Devel/Declare/Context/Simple.pm
===================================================================
--- Devel-Declare/1.000/branches/context_object/lib/Devel/Declare/Context/Simple.pm 2008-10-18 12:22:44 UTC (rev 4934)
+++ Devel-Declare/1.000/branches/context_object/lib/Devel/Declare/Context/Simple.pm 2008-10-18 13:40:29 UTC (rev 4935)
@@ -6,95 +6,93 @@
use warnings;
sub new {
- my $class = shift;
- bless {@_}, $class;
+ my $class = shift;
+ bless {@_}, $class;
}
sub init {
- my $ctx = shift;
- @{$ctx}{ qw(Declarator Offset) } = @_;
- $ctx;
+ my $self = shift;
+ @{$self}{ qw(Declarator Offset) } = @_;
+ $self;
}
sub offset : lvalue { shift->{Offset}; }
sub declarator { shift->{Declarator} }
sub skip_declarator {
- my $ctx = shift;
- $ctx->offset += Devel::Declare::toke_move_past_token( $ctx->offset );
+ my $self = shift;
+ $self->offset += Devel::Declare::toke_move_past_token( $self->offset );
}
sub skipspace {
- my $ctx = shift;
- $ctx->offset += Devel::Declare::toke_skipspace( $ctx->offset );
+ my $self = shift;
+ $self->offset += Devel::Declare::toke_skipspace( $self->offset );
}
sub strip_name {
- my $ctx = shift;
- $ctx->skipspace;
- if( my $len = Devel::Declare::toke_scan_word( $ctx->offset, 1 ) ) {
- my $linestr = Devel::Declare::get_linestr();
- my $name = substr( $linestr, $ctx->offset, $len );
- substr( $linestr, $ctx->offset, $len ) = '';
- Devel::Declare::set_linestr($linestr);
- return $name;
- }
- return;
+ my $self = shift;
+ $self->skipspace;
+ if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) {
+ my $linestr = Devel::Declare::get_linestr();
+ my $name = substr( $linestr, $self->offset, $len );
+ substr( $linestr, $self->offset, $len ) = '';
+ Devel::Declare::set_linestr($linestr);
+ return $name;
+ }
+ return;
}
sub strip_proto {
- my $ctx = shift;
- $ctx->skipspace;
+ my $self = shift;
+ $self->skipspace;
- my $linestr = Devel::Declare::get_linestr();
- if( substr( $linestr, $ctx->offset, 1 ) eq '(' ) {
- my $length = Devel::Declare::toke_scan_str( $ctx->offset );
- my $proto = Devel::Declare::get_lex_stuff();
- Devel::Declare::clear_lex_stuff();
- $linestr = Devel::Declare::get_linestr();
- substr( $linestr, $ctx->offset, $length ) = '';
- Devel::Declare::set_linestr($linestr);
- return $proto;
- }
- return;
+ my $linestr = Devel::Declare::get_linestr();
+ if (substr( $linestr, $self->offset, 1 ) eq '(') {
+ my $length = Devel::Declare::toke_scan_str( $self->offset );
+ my $proto = Devel::Declare::get_lex_stuff();
+ Devel::Declare::clear_lex_stuff();
+ $linestr = Devel::Declare::get_linestr();
+ substr( $linestr, $self->offset, $length ) = '';
+ Devel::Declare::set_linestr($linestr);
+ return $proto;
+ }
+ return;
}
sub get_curstash_name {
- return Devel::Declare::get_curstash_name;
+ return Devel::Declare::get_curstash_name;
}
sub shadow {
- my $ctx = shift;
- my $pack = $ctx->get_curstash_name;
- Devel::Declare::shadow_sub( $pack . '::' . $ctx->declarator, $_[0] );
+ my $self = shift;
+ my $pack = $self->get_curstash_name;
+ Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
}
sub inject_if_block {
- my $ctx = shift;
- my $inject = shift;
- $ctx->skipspace;
- my $linestr = Devel::Declare::get_linestr;
- if( substr( $linestr, $ctx->offset, 1 ) eq '{' ) {
- substr( $linestr, $ctx->offset + 1, 0 ) = $inject;
- Devel::Declare::set_linestr($linestr);
- }
+ my $self = shift;
+ my $inject = shift;
+ $self->skipspace;
+ my $linestr = Devel::Declare::get_linestr;
+ if (substr( $linestr, $self->offset, 1 ) eq '{') {
+ substr( $linestr, $self->offset + 1, 0 ) = $inject;
+ Devel::Declare::set_linestr($linestr);
+ }
}
sub scope_injector_call {
- return ' BEGIN { ' . __PACKAGE__ . '::inject_scope }; ';
+ return ' BEGIN { ' . __PACKAGE__ . '::inject_scope }; ';
}
sub inject_scope {
- my $ctx = shift;
- $^H |= 0x120000;
- $^H{DD_METHODHANDLERS} = Scope::Guard->new(
- sub {
- my $linestr = Devel::Declare::get_linestr;
- my $offset = Devel::Declare::get_linestr_offset;
- substr( $linestr, $offset, 0 ) = ';';
- Devel::Declare::set_linestr($linestr);
- }
- );
+ my $self = shift;
+ $^H |= 0x120000;
+ $^H{DD_METHODHANDLERS} = Scope::Guard->new(sub {
+ my $linestr = Devel::Declare::get_linestr;
+ my $offset = Devel::Declare::get_linestr_offset;
+ substr( $linestr, $offset, 0 ) = ';';
+ Devel::Declare::set_linestr($linestr);
+ });
}
1;
Modified: Devel-Declare/1.000/branches/context_object/lib/Devel/Declare/MethodInstaller/Simple.pm
===================================================================
--- Devel-Declare/1.000/branches/context_object/lib/Devel/Declare/MethodInstaller/Simple.pm 2008-10-18 12:22:44 UTC (rev 4934)
+++ Devel-Declare/1.000/branches/context_object/lib/Devel/Declare/MethodInstaller/Simple.pm 2008-10-18 13:40:29 UTC (rev 4935)
@@ -8,54 +8,53 @@
use warnings;
sub install_methodhandler {
- my $class = shift;
- my %args = @_;
- {
- no strict 'refs';
- *{$args{into}.'::'.$args{name}} = sub (&) {};
- }
+ my $class = shift;
+ my %args = @_;
+ {
+ no strict 'refs';
+ *{$args{into}.'::'.$args{name}} = sub (&) {};
+ }
- my $ctx = $class->new( %args );
- Devel::Declare->setup_for(
- $args{into},
- { $args{name} => { const => sub { $ctx->parser(@_) } } }
- );
-
+ my $ctx = $class->new(%args);
+ Devel::Declare->setup_for(
+ $args{into},
+ { $args{name} => { const => sub { $ctx->parser(@_) } } }
+ );
}
sub parser {
- my $ctx = shift;
- $ctx->init(@_);
+ my $self = shift;
+ $self->init(@_);
- $ctx->skip_declarator;
- my $name = $ctx->strip_name;
- my $proto = $ctx->strip_proto;
- my @decl = $ctx->parse_proto($proto);
- my $inject = $ctx->inject_parsed_proto(@decl);
- if( defined $name ) {
- $inject = $ctx->scope_injector_call() . $inject;
- }
- $ctx->inject_if_block($inject);
- if( defined $name ) {
- my $pkg = $ctx->get_curstash_name;
- $name = join( '::', $pkg, $name )
- unless( $name =~ /::/ );
- $ctx->shadow( sub (&) {
- my $code = shift;
- # So caller() gets the subroutine name
- no strict 'refs';
- *{$name} = subname $name => $code;
- });
- } else {
- $ctx->shadow(sub (&) { shift });
- }
+ $self->skip_declarator;
+ my $name = $self->strip_name;
+ my $proto = $self->strip_proto;
+ my @decl = $self->parse_proto($proto);
+ my $inject = $self->inject_parsed_proto(@decl);
+ if (defined $name) {
+ $inject = $self->scope_injector_call() . $inject;
+ }
+ $self->inject_if_block($inject);
+ if (defined $name) {
+ my $pkg = $self->get_curstash_name;
+ $name = join( '::', $pkg, $name )
+ unless( $name =~ /::/ );
+ $self->shadow( sub (&) {
+ my $code = shift;
+ # So caller() gets the subroutine name
+ no strict 'refs';
+ *{$name} = subname $name => $code;
+ });
+ } else {
+ $self->shadow(sub (&) { shift });
+ }
}
+
sub parse_proto { }
+
sub inject_parsed_proto {
- my $ctx = shift;
- shift;
+ return $_[1];
}
-
1;
Modified: Devel-Declare/1.000/branches/context_object/t/methinstaller-simple.t
===================================================================
--- Devel-Declare/1.000/branches/context_object/t/methinstaller-simple.t 2008-10-18 12:22:44 UTC (rev 4934)
+++ Devel-Declare/1.000/branches/context_object/t/methinstaller-simple.t 2008-10-18 13:40:29 UTC (rev 4935)
@@ -34,7 +34,7 @@
MethodHandlers->install_methodhandler(
name => 'method',
into => __PACKAGE__,
- );
+ );
}
method new {
More information about the Bast-commits
mailing list