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 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 $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};

}

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