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
store_path
default_queue
background
debug

server
/ );

use CWMP::Session;

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,
        store_path => 'state.db',
        default_queue => [ qw/GetRPCMethods GetParameterNames/ ],                                                           
        background => 1,
        debug => 1
  });

Options:

=over 4

=item port

port to listen on

=item store_path

path to L<DBM::Deep> database file to preserve state

=item default_queue

commands which will be issued to every CPE on connect

=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,
                        default_queue => $self->default_queue,
                        store_path => $self->store_path,
                        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/ store_path debug / ) {
                $prop->{ $p } ||= undef;
                $template->{ $p } = \$prop->{ $p };
        }

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

        warn dump( $prop );
}


=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;

        warn "default CPE queue ( " . join(",",@{$prop->{default_queue}}) . " )" if defined($prop->{default_queue});

        warn "sock = ",dump( $sock );

        my $session = CWMP::Session->new({
                sock => $sock,
                queue => $prop->{default_queue},
                store_path => $prop->{store_path},
                debug => $prop->{debug},
        }) || confess "can't create session";

        while ( $session->process_request ) {
                warn "...another one bites the dust...\n";
        }

        warn "...returning to accepting new connections\n";

}

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			store_path
11			default_queue
12	dpavlin	84	background
13	dpavlin	83	debug
14	dpavlin	84
15			server
16	dpavlin	83	/ );
17
18			use CWMP::Session;
19
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			store_path => 'state.db',
34			default_queue => [ qw/GetRPCMethods GetParameterNames/ ],
35	dpavlin	84	background => 1,
36	dpavlin	83	debug => 1
37			});
38
39			Options:
40
41			=over 4
42
43			=item port
44
45			port to listen on
46
47			=item store_path
48
49			path to L<DBM::Deep> database file to preserve state
50
51			=item default_queue
52
53			commands which will be issued to every CPE on connect
54
55			=back
56
57			=cut
58
59			sub new {
60			my $class = shift;
61			my $self = $class->SUPER::new( @_ );
62
63			warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
64
65	dpavlin	84	warn "ACS waiting for request on port ", $self->port, "\n";
66
67			$self->debug( 0 ) unless $self->debug;
68			warn "## debug level: ", $self->debug, "\n" if $self->debug;
69
70			$self->server(
71			CWMP::Server::Helper->new({
72			proto => 'tcp',
73			port => $self->port,
74			default_queue => $self->default_queue,
75			store_path => $self->store_path,
76			debug => $self->debug,
77			background => $self->background,
78			})
79			);
80
81	dpavlin	83	return $self;
82			}
83
84			=head2 run
85
86			=cut
87
88			sub run {
89			my $self = shift;
90
91	dpavlin	84	$self->server->run;
92			}
93	dpavlin	83
94	dpavlin	84	package CWMP::Server::Helper;
95	dpavlin	83
96	dpavlin	84	use warnings;
97			use strict;
98	dpavlin	83
99	dpavlin	84	use base qw/Net::Server/;
100			use Carp qw/confess/;
101			use Data::Dump qw/dump/;
102	dpavlin	83
103	dpavlin	84	sub options {
104			my $self = shift;
105			my $prop = $self->{'server'};
106			my $template = shift;
107	dpavlin	83
108	dpavlin	84	### setup options in the parent classes
109			$self->SUPER::options($template);
110	dpavlin	83
111	dpavlin	84	# new single-value options
112			foreach my $p ( qw/ store_path debug / ) {
113			$prop->{ $p } \|\|= undef;
114			$template->{ $p } = \$prop->{ $p };
115			}
116	dpavlin	83
117	dpavlin	84	# new multi-value options
118			foreach my $p ( qw/ default_queue / ) {
119			$prop->{ $p } \|\|= [];
120			$template->{ $p } = $prop->{ $p };
121	dpavlin	83	}
122	dpavlin	84
123			warn dump( $prop );
124	dpavlin	83	}
125
126	dpavlin	84
127			=head2 process_request
128
129			=cut
130
131			sub process_request {
132			my $self = shift;
133
134			my $prop = $self->{server};
135			confess "no server in ", ref( $self ) unless $prop;
136			my $sock = $prop->{client};
137			confess "no sock in ", ref( $self ) unless $sock;
138
139			warn "default CPE queue ( " . join(",",@{$prop->{default_queue}}) . " )" if defined($prop->{default_queue});
140
141			warn "sock = ",dump( $sock );
142
143			my $session = CWMP::Session->new({
144			sock => $sock,
145			queue => $prop->{default_queue},
146			store_path => $prop->{store_path},
147			debug => $prop->{debug},
148			}) \|\| confess "can't create session";
149
150			while ( $session->process_request ) {
151			warn "...another one bites the dust...\n";
152			}
153
154			warn "...returning to accepting new connections\n";
155
156			}
157
158	dpavlin	83	1;