1 # Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
7 use base qw/Class::Accessor/;
8 __PACKAGE__->mk_accessors( qw/
21 use Data::Dump qw/dump/;
25 CWMP::Server - description
31 my $server = CWMP::Server->new({
33 store_path => 'state.db',
34 default_queue => [ qw/GetRPCMethods GetParameterNames/ ],
49 path to L<DBM::Deep> database file to preserve state
53 commands which will be issued to every CPE on connect
61 my $self = $class->SUPER::new( @_ );
63 warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
65 warn "ACS waiting for request on port ", $self->port, "\n";
67 $self->debug( 0 ) unless $self->debug;
68 warn "## debug level: ", $self->debug, "\n" if $self->debug;
71 CWMP::Server::Helper->new({
74 default_queue => $self->default_queue,
75 store_path => $self->store_path,
76 debug => $self->debug,
77 background => $self->background,
94 package CWMP::Server::Helper;
99 use base qw/Net::Server/;
100 use Carp qw/confess/;
101 use Data::Dump qw/dump/;
105 my $prop = $self->{'server'};
106 my $template = shift;
108 ### setup options in the parent classes
109 $self->SUPER::options($template);
111 # new single-value options
112 foreach my $p ( qw/ store_path debug / ) {
113 $prop->{ $p } ||= undef;
114 $template->{ $p } = \$prop->{ $p };
117 # new multi-value options
118 foreach my $p ( qw/ default_queue / ) {
119 $prop->{ $p } ||= [];
120 $template->{ $p } = $prop->{ $p };
125 =head2 process_request
129 sub process_request {
132 my $prop = $self->{server};
133 confess "no server in ", ref( $self ) unless $prop;
134 my $sock = $prop->{client};
135 confess "no sock in ", ref( $self ) unless $sock;
137 warn "default CPE queue ( " . join(",",@{$prop->{default_queue}}) . " )\n" if defined($prop->{default_queue});
139 my $session = CWMP::Session->new({
141 queue => $prop->{default_queue},
142 store_path => $prop->{store_path},
143 debug => $prop->{debug},
144 }) || confess "can't create session";
146 while ( $session->process_request ) {
147 warn "...another one bites the dust...\n";
150 warn "...returning to accepting new connections\n";