borrowed some code from DDCS

diff --git a/MANIFEST b/MANIFEST
index bf81926..05b79ee 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -11,8 +11,9 @@ lib/Keyword/Parse/Proto.pm
 examples/DDExample.pm
 examples/Methods.pm
 examples/SQL.pm
-t/00-use.t
-t/01-dd-example.t
-t/02-syntax.t
+t/sanity.t
+t/ddexample.t
+t/syntax.t
+t/pod.t
 t/usecase/methods.t
 t/usecase/sql.t

diff --git a/lib/Keyword.pm b/lib/Keyword.pm
index ea7961d..586e52a 100644 (file)
--- a/lib/Keyword.pm
+++ b/lib/Keyword.pm
@@ -110,7 +110,7 @@ sub action_parser {
        confess "expecting identifier for action near:\n".$kd->line;
 
        $kd->skip_ws;
-       my $proto = parse_proto($kd)    or
+       my $proto = parse_proto($kd) or
        confess "expecting prototype for action at:\n".$kd->line;
 
        $kd->skip_ws;

diff --git a/lib/Keyword/Declare.pm b/lib/Keyword/Declare.pm
index b77181a..a012799 100644 (file)
--- a/lib/Keyword/Declare.pm
+++ b/lib/Keyword/Declare.pm
@@ -5,6 +5,9 @@ use Carp;
 use Devel::Declare;
 use Data::Dumper;
 
+#TODO organise high level and low level methods
+#TODO possible import strip_names_and_args
+
 =head1 NAME
 
 Keyword::Declare - simple oo interface to Devel::Declare
@@ -41,8 +44,8 @@ sub offset {
 }
 
 sub declarator {
-  my $self = shift;
-  return $self->{declarator}
+       my $self = shift;
+       return $self->{declarator}
 }
 
 =head2 inc_offset
@@ -76,30 +79,62 @@ sub next_token {
        $self->{offset} += Devel::Declare::toke_move_past_token($self->offset);
 }
 
+=head2 skip_token
 
-=head2 skip_to
-
-skips along until it finds a token matching
+skips a token matching 
 
 =cut
 
-sub skip_to {
+sub skip_token {
        my ($self, $token) = @_;;
-       $token ||= $self->declarator;
        my $len = $self->scan_word(0);
-       confess "Couldn't find token '$token'"
-               unless $len;
+       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 $name = substr($l, $self->offset, $len);
-       confess "Expected declarator '$token', got '${name}'"
-       unless $name eq $token;
+       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
+#strip out everything until a certain char is matched
 
 =cut
 
@@ -150,6 +185,17 @@ sub scan_word {
        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

diff --git a/lib/Keyword/Parser.pm b/lib/Keyword/Parser.pm
index 757aa1d..c635332 100644 (file)
--- a/lib/Keyword/Parser.pm
+++ b/lib/Keyword/Parser.pm
@@ -25,11 +25,13 @@ sub build {
        $self->_lookup_routines;
        
        return sub {
-               $self->declare(Keyword::Declare->new(@_));
-               my @arg;
-               $self->declare->skip_to;
-               $self->declare->skip_ws;
+               my $kd = Keyword::Declare->new(@_);
+               $kd->skip_token($kd->declarator);
+               $kd->skip_ws;
+
+               $self->declare($kd);
 
+               my @arg;
                #call each parse routine and action
                for my $pa (@{$self->{plist}}) {
                        push @arg, $self->exec($pa);