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	#!/usr/bin/perl
2	use strict;
3	use warnings;
4
5	my $debug = shift @ARGV;
6
7	use Test::More tests => 153;
8	use Data::Dump qw/dump/;
9	use Cwd qw/abs_path/;
10	use File::Find;
11	use File::Slurp;
12	use File::Path qw/rmtree mkpath/;
13	use YAML::Syck;
14	use blib;
15
16	BEGIN {
17	use_ok('Net::HTTP');
18	use_ok('CWMP::Server');
19	use_ok('CWMP::Store');
20	use_ok('CWMP::Request');
21	}
22
23	my $port = 4242;
24
25	eval {
26	$SIG{ALRM} = sub { die; };
27	alarm 30;
28	};
29
30	ok(my $abs_path = abs_path($0), "abs_path");
31	$abs_path =~ s!/[^/]*$!/!; #!fix-vim
32
33	my $store_path = "$abs_path/var/";
34	my $store_module = 'YAML';
35
36	rmtree $store_path if -e $store_path;
37	ok( mkpath $store_path, "mkpath $store_path" );
38
39	ok( my $server = CWMP::Server->new({
40	debug => $debug,
41	port => $port,
42	session => {
43	store => {
44	module => $store_module,
45	path => $store_path,
46	# clean => 1,
47	},
48	create_dump => 0,
49	}
50	}), 'new' );
51	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	sleep 1; # so server can start
67
68	my $s;
69
70	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
77	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	}
91
92	sub test_request {
93	my $path = shift;
94
95	ok( -e $path, $path );
96
97	cpe_disconnect if $path =~ m/Inform/;
98	cpe_connect;
99
100	ok( $s->write_request(
101	POST => '/',
102	'Transfer-Encoding' => 'chunked',
103	'SOAPAction' => '',
104	'Content-Type' => 'text/xml',
105	), 'write_request' );
106
107	my $xml = read_file( $path );
108	$xml =~ s/^.+?</</s;
109
110	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	diag "shutdown server";
168
169	ok( kill(9,$pid), 'kill ' . $pid );
170
171	ok( waitpid($pid,0), 'waitpid' );
172