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
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,
        store => {
                module => 'DBMDeep',
                path => 'var/',
        },
        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.

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

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

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