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
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 => {
                module => 'DBMDeep',
                path => 'var/',
        },
        default_queue => [ qw/GetRPCMethods GetParameterNames/ ],                                                           
        background => 1,
        debug => 1
  });

Options:

=over 4

=item port

port to listen on

=item store

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

=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 => $self->store,
                        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 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;

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

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

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

        if ($@) {
                warn $@;
        }

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

}

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