trunk/t/30-server.t

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

my $debug = shift @ARGV;

use Test::More tests => 153;
use Data::Dump qw/dump/;
use Cwd qw/abs_path/;
use File::Find;
use File::Slurp;
use File::Path qw/rmtree mkpath/;
use YAML::Syck;
use blib;

BEGIN {
        use_ok('Net::HTTP');
        use_ok('CWMP::Server');
        use_ok('CWMP::Store');
        use_ok('CWMP::Request');
}

my $port = 4242;

eval {
        $SIG{ALRM} = sub { die; };
        alarm 30;
};

ok(my $abs_path = abs_path($0), "abs_path");
$abs_path =~ s!/[^/]*$!/!;      #!fix-vim

my $store_path = "$abs_path/var/";
my $store_module = 'YAML';

rmtree $store_path if -e $store_path;
ok( mkpath $store_path, "mkpath $store_path" );

ok( my $server = CWMP::Server->new({
        debug => $debug,
        port => $port,
        session => {
                store => {
                        module => $store_module,
                        path => $store_path,
#                       clean => 1,
                },
                create_dump => 0,
        }
}), 'new' );
isa_ok( $server, 'CWMP::Server' );

my $pid;

if ( $pid = fork ) {
        ok( $pid, 'fork ');
        diag "forked $pid";
} elsif (defined($pid)) {
        # child
        $server->run;
        exit;
} else {
        die "can't fork";
}

sleep 1;        # so server can start

my $s;

sub cpe_connect {
        return $s if $s;
        diag "CPE connect";
        ok( $s = Net::HTTP->new(Host => "localhost:$port"), 'CPE client' );
        $s->keep_alive( 1 );
}

sub cpe_disconnect {
        return unless $s;
        diag "CPE disconnect";
        $s->keep_alive( 0 );
        ok( $s->write_request(
                POST => '/',
                'SOAPAction' => '',
                'Content-Type' => 'text/xml',
        ), 'write_request' );
        my ($code, $mess, %h) = $s->read_response_headers;
        undef $s;
        diag "$code $mess";
        return $code == 200 ? 1 : 0;
}

sub test_request {
        my $path = shift;

        ok( -e $path, $path );

        cpe_disconnect if $path =~ m/Inform/;
        cpe_connect;

        ok( $s->write_request(
                POST => '/',
                'Transfer-Encoding' => 'chunked',
                'SOAPAction' => '',
                'Content-Type' => 'text/xml',
        ), 'write_request' );

        my $xml = read_file( $path );
        $xml =~ s/^.+?</</s;

        my $chunk_size = 5000;

        foreach my $part ( 0 .. int( length($xml) / $chunk_size ) ) {
                my $chunk = substr( $xml, $part * $chunk_size, $chunk_size );
                ok( $s->write_chunk( $chunk ), "chunk $part " . length($chunk) . " bytes" );
        }
        ok( $s->write_chunk_eof, 'write_chunk_eof' );

        my($code, $mess, %h) = $s->read_response_headers;
        diag "$code $mess";
        while (1) {
                my $buf;
                my $n = $s->read_entity_body($buf, 1024);
                die "read failed: $!" unless defined $n;
                last unless $n;
                diag $buf;
        }

        ok( my $store = CWMP::Store->new({ module => $store_module, path => $store_path, debug => $debug }), 'another store' );

        my $state = LoadFile( "$path.yml" );

        $path =~ s!/[^/]+$!!; #!vim
        ok( my $uid = $store->state_to_uid( LoadFile( "$path/Inform.yml" ) ), 'state_to_uid' );

        ok( my $store_state = $store->current_store->get_state( $uid ), 'get_state' );

        my $s;

        # ignore
        foreach my $k ( keys %$state ) {
                if ( defined( $store_state->{$k} ) ) {
                        $s->{$k} = $store_state->{$k};
                } else {
                        die "store_state doesn't have $k: ",dump( $store_state );
                }
        }

        is_deeply( $s, $state, 'store->current_store->get_state' );

}

find({
        no_chdir => 1,
        wanted => sub {
                my $path = $File::Find::name;
                return unless -f $path;
                return if $path =~ m/\.yml$/;
                eval {
                        test_request( $path );
                };
                ok( ! $@, "request $path" );
        }
},'t/dump/');

ok( cpe_disconnect, 'cpe_disconnect' );

diag "shutdown server";

ok( kill(9,$pid), 'kill ' . $pid );

ok( waitpid($pid,0), 'waitpid' );

1	dpavlin	41	#!/usr/bin/perl
2			use strict;
3			use warnings;
4
5			my $debug = shift @ARGV;
6
7	dpavlin	238	use Test::More tests => 153;
8	dpavlin	41	use Data::Dump qw/dump/;
9	dpavlin	77	use Cwd qw/abs_path/;
10	dpavlin	234	use File::Find;
11			use File::Slurp;
12			use File::Path qw/rmtree mkpath/;
13			use YAML::Syck;
14	dpavlin	41	use blib;
15
16			BEGIN {
17			use_ok('Net::HTTP');
18			use_ok('CWMP::Server');
19	dpavlin	85	use_ok('CWMP::Store');
20	dpavlin	234	use_ok('CWMP::Request');
21	dpavlin	41	}
22
23			my $port = 4242;
24
25			eval {
26			$SIG{ALRM} = sub { die; };
27			alarm 30;
28			};
29
30	dpavlin	77	ok(my $abs_path = abs_path($0), "abs_path");
31			$abs_path =~ s!/[^/]*$!/!; #!fix-vim
32
33	dpavlin	163	my $store_path = "$abs_path/var/";
34			my $store_module = 'YAML';
35	dpavlin	84
36	dpavlin	234	rmtree $store_path if -e $store_path;
37			ok( mkpath $store_path, "mkpath $store_path" );
38
39	dpavlin	77	ok( my $server = CWMP::Server->new({
40			debug => $debug,
41			port => $port,
42	dpavlin	205	session => {
43			store => {
44			module => $store_module,
45			path => $store_path,
46	dpavlin	234	# clean => 1,
47	dpavlin	205	},
48			create_dump => 0,
49			}
50	dpavlin	77	}), 'new' );
51	dpavlin	41	isa_ok( $server, 'CWMP::Server' );
52
53			my $pid;
54
55			if ( $pid = fork ) {
56			ok( $pid, 'fork ');
57			diag "forked $pid";
58			} elsif (defined($pid)) {
59			# child
60			$server->run;
61			exit;
62			} else {
63			die "can't fork";
64			}
65
66	dpavlin	84	sleep 1; # so server can start
67
68	dpavlin	234	my $s;
69	dpavlin	41
70	dpavlin	234	sub cpe_connect {
71			return $s if $s;
72			diag "CPE connect";
73			ok( $s = Net::HTTP->new(Host => "localhost:$port"), 'CPE client' );
74			$s->keep_alive( 1 );
75			}
76	dpavlin	41
77	dpavlin	234	sub cpe_disconnect {
78			return unless $s;
79			diag "CPE disconnect";
80			$s->keep_alive( 0 );
81			ok( $s->write_request(
82			POST => '/',
83			'SOAPAction' => '',
84			'Content-Type' => 'text/xml',
85			), 'write_request' );
86			my ($code, $mess, %h) = $s->read_response_headers;
87			undef $s;
88			diag "$code $mess";
89			return $code == 200 ? 1 : 0;
90	dpavlin	41	}
91
92	dpavlin	234	sub test_request {
93			my $path = shift;
94	dpavlin	41
95	dpavlin	234	ok( -e $path, $path );
96	dpavlin	85
97	dpavlin	234	cpe_disconnect if $path =~ m/Inform/;
98			cpe_connect;
99	dpavlin	85
100	dpavlin	234	ok( $s->write_request(
101			POST => '/',
102			'Transfer-Encoding' => 'chunked',
103			'SOAPAction' => '',
104			'Content-Type' => 'text/xml',
105			), 'write_request' );
106	dpavlin	85
107	dpavlin	234	my $xml = read_file( $path );
108			$xml =~ s/^.+?</</s;
109	dpavlin	223
110	dpavlin	234	my $chunk_size = 5000;
111
112			foreach my $part ( 0 .. int( length($xml) / $chunk_size ) ) {
113			my $chunk = substr( $xml, $part * $chunk_size, $chunk_size );
114			ok( $s->write_chunk( $chunk ), "chunk $part " . length($chunk) . " bytes" );
115			}
116			ok( $s->write_chunk_eof, 'write_chunk_eof' );
117
118			my($code, $mess, %h) = $s->read_response_headers;
119			diag "$code $mess";
120			while (1) {
121			my $buf;
122			my $n = $s->read_entity_body($buf, 1024);
123			die "read failed: $!" unless defined $n;
124			last unless $n;
125			diag $buf;
126			}
127
128			ok( my $store = CWMP::Store->new({ module => $store_module, path => $store_path, debug => $debug }), 'another store' );
129
130			my $state = LoadFile( "$path.yml" );
131
132			$path =~ s!/[^/]+$!!; #!vim
133			ok( my $uid = $store->state_to_uid( LoadFile( "$path/Inform.yml" ) ), 'state_to_uid' );
134
135			ok( my $store_state = $store->current_store->get_state( $uid ), 'get_state' );
136
137			my $s;
138
139			# ignore
140			foreach my $k ( keys %$state ) {
141			if ( defined( $store_state->{$k} ) ) {
142			$s->{$k} = $store_state->{$k};
143			} else {
144			die "store_state doesn't have $k: ",dump( $store_state );
145			}
146			}
147
148			is_deeply( $s, $state, 'store->current_store->get_state' );
149
150			}
151
152			find({
153			no_chdir => 1,
154			wanted => sub {
155			my $path = $File::Find::name;
156			return unless -f $path;
157			return if $path =~ m/\.yml$/;
158			eval {
159			test_request( $path );
160			};
161			ok( ! $@, "request $path" );
162			}
163			},'t/dump/');
164
165			ok( cpe_disconnect, 'cpe_disconnect' );
166
167	dpavlin	197	diag "shutdown server";
168
169	dpavlin	84	ok( kill(9,$pid), 'kill ' . $pid );
170
171	dpavlin	41	ok( waitpid($pid,0), 'waitpid' );
172	dpavlin	205