use CWMP::Tree;
use Data::Dump qw/dump/;
use Carp qw/confess cluck/;
+use Class::Trigger;
=head1 NAME
=head1 CPE metods
+All methods described below call triggers with same name
+
=cut
my $tree = CWMP::Tree->new({ debug => 0 });
push @$rules,
'Inform' => sub {
$state->{_dispatch} = 'InformResponse'; # what reponse to call
+ $state->{_trigger} = 'Inform';
};
=head2 GetRPCMethodsResponse
'MethodList' => sub {
my ($tag_name, $tag_hash, $context, $parent_data) = @_;
$state->{MethodList} = _tag( $tag_hash, 'string' );
+ $state->{_trigger} = 'GetRPCMethodsResponse';
};
=head2 GetParameterNamesResponse
confess "can't eval $s : $@" if ($@);
#warn "## state = dump( $state ), "\n";
+
+ $state->{_trigger} = 'GetParameterNamesResponse';
};
=head2 Fault
FaultString => _tag( $tag_hash, 'FaultString', '_content' ),
};
warn "FAULT: ", $state->{Fault}->{FaultCode}, " ", $state->{Fault}->{FaultString}, "\n";
+ $state->{_trigger} = 'Fault';
};
my $parser = XML::Rules->new(
$state = {};
$parser->parsestring( $xml );
+ if ( my $trigger = $state->{_trigger} ) {
+ __PACKAGE__->call_trigger( $trigger, $state );
+ }
+ # XXX don't propagate _trigger (useful?)
+ delete( $state->{_trigger} );
return $state;
}
my $debug = shift @ARGV;
-use Test::More tests => 53;
+use Test::More tests => 73;
use Data::Dump qw/dump/;
use Cwd qw/abs_path/;
use File::Slurp;
ok(my $abs_path = abs_path($0), "abs_path");
$abs_path =~ s!/[^/]*$!/!; #!fix-vim
+my $path2method;
+my $triggers_count;
+
sub file_is_deeply {
my ( $path ) = @_;
diag $xml if $debug;
+ ok( my $trigger = $path2method->{$path}, "path2method($path)" );
+
+ CWMP::Request->add_trigger( name => $trigger, callback => sub {
+ my ( $self, $state ) = @_;
+ $triggers_count->{$trigger}++;
+ ok( $state, "called trigger $trigger" );
+ });
+
ok( my $state = CWMP::Request->parse( $xml ), 'parse' );
my $dump_path = $path;
my $dir = "$abs_path/$model/";
opendir(DIR, $dir) || die "can't opendir $dir: $!";
- my @xmls = map { "$dir/$_" } grep { /\.xml$/ && -f "$dir/$_" } readdir(DIR);
+ my @xmls = map {
+ my $path = "$dir/$_";
+ my $method = $_;
+ $method =~ s/\.xml$//;
+ $path2method->{$path} = $method;
+ $path;
+ } grep { /\.xml$/ && -f "$dir/$_" } readdir(DIR);
closedir DIR;
diag "$model has ", $#xmls + 1, " xml tests";
}
}
+diag "triggers_count = ",dump( $triggers_count ) if $debug;
+