renamed package to Context

- now inline with Test::Class::Sugar and DD

diff --git a/lib/Devel/Declare/Keyword.pm b/lib/Devel/Declare/Keyword.pm
index 4c43bc2..1deb6ad 100644 (file)
--- a/lib/Devel/Declare/Keyword.pm
+++ b/lib/Devel/Declare/Keyword.pm
@@ -6,7 +6,7 @@ use Carp;
 use Devel::Declare;
 use B::Hooks::EndOfScope;
 use Data::Dumper;
-use Devel::Declare::Keyword::Declare;
+use Devel::Declare::Keyword::Context;
 use Devel::Declare::Keyword::Parser;
 use Devel::Declare::Keyword::Parse::Block;
 use Devel::Declare::Keyword::Parse::Proto 'parse_proto';
@@ -41,7 +41,7 @@ sub import {
 
 #parses keyword signature
 sub keyword_parser {
-       my $kd = Devel::Declare::Keyword::Declare->new(@_);
+       my $kd = Devel::Declare::Keyword::Context->new(@_);
        $kd->next_token;
        $kd->skip_ws;
 
@@ -74,7 +74,7 @@ sub keyword_parser {
 
 # parses the parse keyword
 sub parse_parser {
-       my $kd = Devel::Declare::Keyword::Declare->new(@_);
+       my $kd = Devel::Declare::Keyword::Context->new(@_);
        $kd->next_token;
        $kd->skip_ws;
 
@@ -101,7 +101,7 @@ sub parse_parser {
 
 # parses the action keyword
 sub action_parser {
-       my $kd = Devel::Declare::Keyword::Declare->new(@_);
+       my $kd = Devel::Declare::Keyword::Context->new(@_);
        $kd->next_token;
        $kd->skip_ws;
 
@@ -128,7 +128,7 @@ sub action_parser {
 
 sub eos {
        on_scope_end {
-               my $kd = Devel::Declare::Keyword::Declare->new;
+               my $kd = Devel::Declare::Keyword::Context->new;
                my $l = $kd->line;
                my $loffset = $kd->line_offset;
                substr($l, $loffset, 0) = ';';
@@ -149,8 +149,6 @@ sub kw_proto_to_code {
        return $inject;
 }
 
-sub debug { warn "DEBUG: @_\n" if $DEBUG; }
-
 # build import routine for new keyword module
 sub mk_import {
        my ($parser, $keyword, $block) = @_;

diff --git a/lib/Devel/Declare/Keyword/Context.pm b/lib/Devel/Declare/Keyword/Context.pm
new file mode 100644 (file)
index 0000000..bc7ba6c
--- /dev/null
+++ b/lib/Devel/Declare/Keyword/Context.pm
@@ -0,0 +1,305 @@
+package Devel::Declare::Keyword::Context;
+use strict;
+use warnings;
+use Carp;
+use Devel::Declare;
+use Data::Dumper;
+
+#TODO possible import strip_names_and_args
+
+=head1 NAME
+
+Devel::Declare::Keyword::Context - simple interface to Devel::Declare
+
+=cut
+
+=head1 SYNOPSIS
+
+ my $kc = new Devel::Declare::Keyword::Context;
+ print $kc->line;
+
+=cut
+
+
+sub new {
+       my ($class,$decl,$offset) = @_;
+    my $self = {};
+       $self->{offset} = $offset || 0;
+       $self->{declarator} = $decl;
+       bless($self,$class);    
+}
+
+=head1 METHODS
+
+=head2 offset
+
+for setting and retrieving the offset
+
+=cut
+
+sub offset {
+       my ($self, $offset) = @_;
+       $self->{offset} = $offset if $offset;
+       return $self->{offset};
+}
+
+sub declarator {
+       my $self = shift;
+       return $self->{declarator}
+}
+
+=head2 inc_offset
+
+increments the current offset
+
+ $kd->inc_offset; # by one
+ $kd->inc_offset(23);
+
+=cut
+
+sub inc_offset {
+       my ($self, $offset) = @_;
+       if($offset) {
+               $self->{offset} += $offset;
+       }
+       else {
+               $self->{offset}++;
+       }
+       return $self->{offset};
+}
+
+=head2 next_token
+
+skips to the next token
+
+=cut
+
+sub next_token {
+       my ($self) = @_;
+       $self->{offset} += Devel::Declare::toke_move_past_token($self->offset);
+}
+
+=head2 skip_token
+
+skips a token matching 
+
+=cut
+
+sub skip_token {
+       my ($self, $token) = @_;;
+       my $len = $self->scan_word(0);
+       confess "Couldn't find token '$token'" unless $len;
+
+       my $l = $self->line;
+       my $match = substr($l, $self->offset, $len);
+       confess "Expected declarator '$token', got '${match}'"
+       unless $match eq $token;
+       $self->inc_offset($len);
+       return $match;
+}
+
+
+=head2 strip_token
+
+strips a token 
+
+=cut
+
+sub strip_token {
+       my ($self) = @_;;
+       my $len = $self->scan_word(0);
+       confess "Couldn't find a token." unless $len;
+       my $l = $self->line;
+       my $match = substr($l, $self->offset, $len) = '';
+       $self->inc_offset($len);
+       return $match;
+}
+
+=head2 strip_ident
+
+strips an identifier
+
+=cut
+
+sub strip_ident {
+       my $self = shift;
+       if (my $len = Devel::Declare::toke_scan_ident( $self->offset )) {
+               my $l = $self->line;
+               my $ident = substr($l, $self->offset, $len);
+               substr($l, $self->offset, $len) = '';
+               $self->line($l);
+               return $ident;
+       }
+}
+
+=head2 strip_to_char
+
+#strip out everything until a certain char is matched
+
+=cut
+
+sub strip_to_char {
+       my ($self, $char) = @_;
+       my $str = "";
+       while ($str !~ /$char/) {
+               my $l = $self->line;
+               $str .= substr($l, $self->offset, 1);
+               substr($l, $self->offset, 1) = '';
+               $self->line($l);
+       }
+       return $str;
+}
+
+=head2 terminate
+
+inject a semi colon
+
+=cut
+
+sub terminate {
+       my ($self) = shift;
+       my $l = $self->line;
+       substr($l, $self->offset, 1) = ';';
+       $self->line($l);
+}
+
+=head2 skip_ws
+
+skip past white space
+
+=cut
+
+sub skip_ws {
+       my ($self) = @_;
+       $self->{offset} +=      Devel::Declare::toke_skipspace($self->offset);
+}
+
+=head2 scan_word
+
+scan in a word, see also scanned
+
+=cut
+
+sub scan_word {
+       my ($self, $n) = @_;
+       return Devel::Declare::toke_scan_word($self->offset, $n);
+}
+
+=head2 scan_ident
+
+scan in a ident, see also scanned
+
+=cut
+
+sub scan_ident {
+       my ($self, $n) = @_;
+       return Devel::Declare::toke_scan_ident($self->offset, $n);
+}
+
+=head2 scan_string
+
+scan a quoted string, see also scanned
+
+=cut
+
+sub scan_string {
+       my ($self) = @_;
+       return Devel::Declare::toke_scan_str($self->offset);
+}
+
+=head2 scanned
+
+returns whatever the parser has scanned
+
+=cut
+
+sub scanned {
+       my ($self) = @_;
+       my $stream = Devel::Declare::get_lex_stuff();
+       Devel::Declare::clear_lex_stuff();
+       return $stream;
+}
+
+
+=head2 line
+
+get or set the current line
+
+=cut
+
+sub line {
+       my ($self, $line) = @_;
+       Devel::Declare::set_linestr($line) if $line;
+       return Devel::Declare::get_linestr;
+}
+
+=head2 package
+
+returns name of package being compiled 
+
+=cut
+
+sub package {
+       return Devel::Declare::get_curstash_name;
+}
+
+=head2 line_offset
+
+get or set the current lines offset
+
+=cut
+
+sub line_offset {
+       my ($self, $os) = @_;
+       Devel::Declare::set_linestr_offset($os) if $os;
+       return Devel::Declare::get_linestr_offset;
+}
+
+=head2 shadow
+
+sets up a shadow subroutine, optionally takes a sub ref as the shadow
+
+ $declare->shadow('Some::Thing::do_something', \&somecoderef)
+
+=cut
+
+sub shadow {
+       my ($self, $name, $sub) = @_;
+
+       #set name as global for import;
+       no strict 'refs'; 
+
+       ${$self->package."::__block_name"} = $name;
+
+       unless ($sub) {
+               if($name) {
+                       $sub = sub (&) {
+                               *{$name} = shift;
+                       };
+               }
+               else {
+                       $sub = sub (&) { shift; };
+               }
+       }
+
+       Devel::Declare::shadow_sub($name, $sub);
+
+    return $sub;
+}
+
+=head1 AUTHOR
+
+Robin Edwards  <robin.ge@gmail.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009 Robin Edwards
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
+
+=cut
+
+1;