t/10-request.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 my $debug = shift @ARGV;
   6
   7 use Test::More tests => 73;
   8 use Data::Dump qw/dump/;
   9 use Cwd qw/abs_path/;
  10 use File::Slurp;
  11 use blib;
  12
  13 # XML::Rules doesn't like it!
  14 #use Devel::LeakTrace::Fast;
  15
  16 BEGIN {
  17         use_ok('CWMP::Request');
  18 }
  19
  20 my @models = ( qw/SpeedTouch-706 SpeedTouch-780/ );
  21
  22 ok( $#models + 1, 'got models' );
  23
  24 ok(my $abs_path = abs_path($0), "abs_path");
  25 $abs_path =~ s!/[^/]*$!/!;      #!fix-vim
  26
  27 my $path2method;
  28 my $triggers_count;
  29
  30 sub file_is_deeply {
  31         my ( $path ) = @_;
  32
  33         ok( my $xml = read_file( $path ), "read_file( $path )" );
  34
  35         diag $xml if $debug;
  36
  37         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         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         diag "$path ? $dump_path" if $debug;
  53
  54         ok( my $hash = read_file( $dump_path ), "read_file( $dump_path )" );
  55         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         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         closedir DIR;
  72
  73         diag "$model has ", $#xmls + 1, " xml tests";
  74
  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 diag "triggers_count = ",dump( $triggers_count ) if $debug;
  84