lib/CWMP/Server.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
package CWMP::Server;

use strict;
use warnings;

use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors( qw/
port
session
background
debug

server
/ );

use CWMP::Session;
use CWMP::Queue;
use CWMP::MemLeak;

use Carp qw/confess/;
use Data::Dump qw/dump/;

=head1 NAME

CWMP::Server - description

=head1 METHODS

=head2 new

  my $server = CWMP::Server->new({
        port => 3333,
        session => { ... },
        background => 1,
        debug => 1
  });

Options:

=over 4

=item port

port to listen on

=item session

hash with key C<module> with value C<DBMDeep> if L<CWMP::Store::DBMDeep>
is used. Other parametars are optional.

=back

=cut

sub new {
        my $class = shift;
        my $self = $class->SUPER::new( @_ );

        warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;

        warn "ACS waiting for request on port ", $self->port, "\n";

        $self->debug( 0 ) unless $self->debug;
        warn "## debug level: ", $self->debug, "\n" if $self->debug;

        $self->server(
                CWMP::Server::Helper->new({
                        proto => 'tcp',
                        port => $self->port,
                        session => $self->session,
                        debug => $self->debug,
                        background => $self->background,
                })
        );

        return $self;
}

=head2 run

=cut

sub run {
        my $self = shift;

        $self->server->run;
}

package CWMP::Server::Helper;

use warnings;
use strict;

use base qw/Net::Server/;
use Carp qw/confess/;
use Data::Dump qw/dump/;

sub options {
        my $self     = shift;
        my $prop     = $self->{'server'};
        my $template = shift;

        ### setup options in the parent classes
        $self->SUPER::options($template);

        # new single-value options
        foreach my $p ( qw/ session debug / ) {
                $prop->{ $p } ||= undef;
                $template->{ $p } = \$prop->{ $p };
        }

        # new multi-value options
#       foreach my $p ( qw/ default_queue / ) {
#               $prop->{ $p } ||= [];
#               $template->{ $p } = $prop->{ $p };
#       }
}


=head2 process_request

=cut

sub process_request {
        my $self = shift;

        my $leak = CWMP::MemLeak->new;

        my $prop = $self->{server};
        confess "no server in ", ref( $self ) unless $prop;
        my $sock = $prop->{client};
        confess "no sock in ", ref( $self ) unless $sock;

        my $sess = $prop->{session} || confess "no session";

        eval  {
                $sess->{sock} = $sock;
                $sess->{debug} = $prop->{debug};

                my $session = CWMP::Session->new( $sess ) || confess "can't create session from ",dump( $sess );

                while ( $session->process_request ) {
                        warn "...waiting for next request from CPE...\n" if $prop->{debug};
                }
        };

        warn "ERROR: $@\n" if $@;

        warn "...returning to accepting new connections\n" if $prop->{debug};

        $leak->report;

}

1;
1	# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
2	package CWMP::Server;
3
4	use strict;
5	use warnings;
6
7	use base qw/Class::Accessor/;
8	__PACKAGE__->mk_accessors( qw/
9	port
10	session
11	background
12	debug
13
14	server
15	/ );
16
17	use CWMP::Session;
18	use CWMP::Queue;
19	use CWMP::MemLeak;
20
21	use Carp qw/confess/;
22	use Data::Dump qw/dump/;
23
24	=head1 NAME
25
26	CWMP::Server - description
27
28	=head1 METHODS
29
30	=head2 new
31
32	my $server = CWMP::Server->new({
33	port => 3333,
34	session => { ... },
35	background => 1,
36	debug => 1
37	});
38
39	Options:
40
41	=over 4
42
43	=item port
44
45	port to listen on
46
47	=item session
48
49	hash with key C<module> with value C<DBMDeep> if L<CWMP::Store::DBMDeep>
50	is used. Other parametars are optional.
51
52	=back
53
54	=cut
55
56	sub new {
57	my $class = shift;
58	my $self = $class->SUPER::new( @_ );
59
60	warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
61
62	warn "ACS waiting for request on port ", $self->port, "\n";
63
64	$self->debug( 0 ) unless $self->debug;
65	warn "## debug level: ", $self->debug, "\n" if $self->debug;
66
67	$self->server(
68	CWMP::Server::Helper->new({
69	proto => 'tcp',
70	port => $self->port,
71	session => $self->session,
72	debug => $self->debug,
73	background => $self->background,
74	})
75	);
76
77	return $self;
78	}
79
80	=head2 run
81
82	=cut
83
84	sub run {
85	my $self = shift;
86
87	$self->server->run;
88	}
89
90	package CWMP::Server::Helper;
91
92	use warnings;
93	use strict;
94
95	use base qw/Net::Server/;
96	use Carp qw/confess/;
97	use Data::Dump qw/dump/;
98
99	sub options {
100	my $self = shift;
101	my $prop = $self->{'server'};
102	my $template = shift;
103
104	### setup options in the parent classes
105	$self->SUPER::options($template);
106
107	# new single-value options
108	foreach my $p ( qw/ session debug / ) {
109	$prop->{ $p } \|\|= undef;
110	$template->{ $p } = \$prop->{ $p };
111	}
112
113	# new multi-value options
114	# foreach my $p ( qw/ default_queue / ) {
115	# $prop->{ $p } \|\|= [];
116	# $template->{ $p } = $prop->{ $p };
117	# }
118	}
119
120
121	=head2 process_request
122
123	=cut
124
125	sub process_request {
126	my $self = shift;
127
128	my $leak = CWMP::MemLeak->new;
129
130	my $prop = $self->{server};
131	confess "no server in ", ref( $self ) unless $prop;
132	my $sock = $prop->{client};
133	confess "no sock in ", ref( $self ) unless $sock;
134
135	my $sess = $prop->{session} \|\| confess "no session";
136
137	eval {
138	$sess->{sock} = $sock;
139	$sess->{debug} = $prop->{debug};
140
141	my $session = CWMP::Session->new( $sess ) \|\| confess "can't create session from ",dump( $sess );
142
143	while ( $session->process_request ) {
144	warn "...waiting for next request from CPE...\n" if $prop->{debug};
145	}
146	};
147
148	warn "ERROR: $@\n" if $@;
149
150	warn "...returning to accepting new connections\n" if $prop->{debug};
151
152	$leak->report;
153
154	}
155
156	1;