trunk/t/10-request.t

#!/usr/bin/perl
use strict;
use warnings;

my $debug = shift @ARGV;

use Test::More tests => 73;
use Data::Dump qw/dump/;
use Cwd qw/abs_path/;
use File::Slurp;
use blib;

# XML::Rules doesn't like it!
#use Devel::LeakTrace::Fast;

BEGIN {
        use_ok('CWMP::Request');
}

my @models = ( qw/SpeedTouch-706 SpeedTouch-780/ );

ok( $#models + 1, 'got models' );

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 ) = @_;

        ok( my $xml = read_file( $path ), "read_file( $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;
        $dump_path =~ s/\.xml/\.pl/;

        write_file( $dump_path, dump( $state ) ) unless ( -e $dump_path );

        diag "$path ? $dump_path" if $debug;

        ok( my $hash = read_file( $dump_path ), "read_file( $dump_path )" );
        ok ( $hash = eval "$hash", 'eval' );

        is_deeply( $state, $hash, 'same' );
}

foreach my $model ( @models ) {

        my $dir = "$abs_path/$model/";
        opendir(DIR, $dir) || die "can't opendir $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";

        ok( $#xmls, "xmls" );

        foreach my $xml_path ( @xmls ) {
                ok ( $xml_path, 'xml path' );
                file_is_deeply( $xml_path );
        }
}

diag "triggers_count = ",dump( $triggers_count ) if $debug;

1	dpavlin	31	#!/usr/bin/perl
2			use strict;
3			use warnings;
4
5			my $debug = shift @ARGV;
6
7	dpavlin	200	use Test::More tests => 73;
8	dpavlin	31	use Data::Dump qw/dump/;
9	dpavlin	58	use Cwd qw/abs_path/;
10			use File::Slurp;
11	dpavlin	31	use blib;
12
13	dpavlin	228	# XML::Rules doesn't like it!
14	dpavlin	227	#use Devel::LeakTrace::Fast;
15
16	dpavlin	31	BEGIN {
17			use_ok('CWMP::Request');
18			}
19
20	dpavlin	69	my @models = ( qw/SpeedTouch-706 SpeedTouch-780/ );
21	dpavlin	31
22	dpavlin	60	ok( $#models + 1, 'got models' );
23	dpavlin	31
24	dpavlin	58	ok(my $abs_path = abs_path($0), "abs_path");
25			$abs_path =~ s!/[^/]*$!/!; #!fix-vim
26	dpavlin	31
27	dpavlin	200	my $path2method;
28			my $triggers_count;
29
30	dpavlin	58	sub file_is_deeply {
31			my ( $path ) = @_;
32	dpavlin	31
33	dpavlin	58	ok( my $xml = read_file( $path ), "read_file( $path )" );
34	dpavlin	31
35	dpavlin	58	diag $xml if $debug;
36	dpavlin	31
37	dpavlin	200	ok( my $trigger = $path2method->{$path}, "path2method($path)" );
38
39			CWMP::Request->add_trigger( name => $trigger, callback => sub {
40			my ( $self, $state ) = @_;
41			$triggers_count->{$trigger}++;
42			ok( $state, "called trigger $trigger" );
43			});
44
45	dpavlin	58	ok( my $state = CWMP::Request->parse( $xml ), 'parse' );
46
47			my $dump_path = $path;
48			$dump_path =~ s/\.xml/\.pl/;
49
50			write_file( $dump_path, dump( $state ) ) unless ( -e $dump_path );
51
52	dpavlin	63	diag "$path ? $dump_path" if $debug;
53	dpavlin	58
54	dpavlin	63	ok( my $hash = read_file( $dump_path ), "read_file( $dump_path )" );
55	dpavlin	58	ok ( $hash = eval "$hash", 'eval' );
56
57			is_deeply( $state, $hash, 'same' );
58			}
59
60			foreach my $model ( @models ) {
61
62			my $dir = "$abs_path/$model/";
63			opendir(DIR, $dir) \|\| die "can't opendir $dir: $!";
64	dpavlin	200	my @xmls = map {
65			my $path = "$dir/$_";
66			my $method = $_;
67			$method =~ s/\.xml$//;
68			$path2method->{$path} = $method;
69			$path;
70			} grep { /\.xml$/ && -f "$dir/$_" } readdir(DIR);
71	dpavlin	58	closedir DIR;
72
73	dpavlin	69	diag "$model has ", $#xmls + 1, " xml tests";
74	dpavlin	58
75			ok( $#xmls, "xmls" );
76
77			foreach my $xml_path ( @xmls ) {
78			ok ( $xml_path, 'xml path' );
79			file_is_deeply( $xml_path );
80			}
81			}
82
83	dpavlin	200	diag "triggers_count = ",dump( $triggers_count ) if $debug;
84