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 => 53;
   8 use Data::Dump qw/dump/;
   9 use Cwd qw/abs_path/;
  10 use File::Slurp;
  11 use blib;
  12
  13 BEGIN {
  14         use_ok('CWMP::Request');
  15 }
  16
  17 my @models = ( qw/SpeedTouch-706 SpeedTouch-780/ );
  18
  19 ok( $#models + 1, 'got models' );
  20
  21 ok(my $abs_path = abs_path($0), "abs_path");
  22 $abs_path =~ s!/[^/]*$!/!;      #!fix-vim
  23
  24 sub file_is_deeply {
  25         my ( $path ) = @_;
  26
  27         ok( my $xml = read_file( $path ), "read_file( $path )" );
  28
  29         diag $xml if $debug;
  30
  31         ok( my $state = CWMP::Request->parse( $xml ), 'parse' );
  32
  33         my $dump_path = $path;
  34         $dump_path =~ s/\.xml/\.pl/;
  35
  36         write_file( $dump_path, dump( $state ) ) unless ( -e $dump_path );
  37
  38         diag "$path ? $dump_path" if $debug;
  39
  40         ok( my $hash = read_file( $dump_path ), "read_file( $dump_path )" );
  41         ok ( $hash = eval "$hash", 'eval' );
  42
  43         is_deeply( $state, $hash, 'same' );
  44 }
  45
  46 foreach my $model ( @models ) {
  47
  48         my $dir = "$abs_path/$model/";
  49         opendir(DIR, $dir) || die "can't opendir $dir: $!";
  50         my @xmls = map { "$dir/$_" } grep { /\.xml$/ && -f "$dir/$_" } readdir(DIR);
  51         closedir DIR;
  52
  53         diag "$model has ", $#xmls + 1, " xml tests";
  54
  55         ok( $#xmls, "xmls" );
  56
  57         foreach my $xml_path ( @xmls ) {
  58                 ok ( $xml_path, 'xml path' );
  59                 file_is_deeply( $xml_path );
  60         }
  61 }
  62