From: Robin Edwards Date: Sun, 11 Apr 2010 17:51:02 +0000 (+0100) Subject: renamed package to Context X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f4efc5fe79388cec1c21cddaa7958c95ec66db80;p=p5sagit%2FDevel-Declare-Keyword.git 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 --- 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 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 + +=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;