lib/CWMP/Server.pm

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