From: Robin Edwards <robin.ge@gmail.com>
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 <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;