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_path
  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_path => '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_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         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         return $self;
  82 }
  83
  84 =head2 run
  85
  86 =cut
  87
  88 sub run {
  89         my $self = shift;
  90
  91         $self->server->run;
  92 }
  93
  94 package CWMP::Server::Helper;
  95
  96 use warnings;
  97 use strict;
  98
  99 use base qw/Net::Server/;
 100 use Carp qw/confess/;
 101 use Data::Dump qw/dump/;
 102
 103 sub options {
 104         my $self     = shift;
 105         my $prop     = $self->{'server'};
 106         my $template = shift;
 107
 108         ### setup options in the parent classes
 109         $self->SUPER::options($template);
 110
 111         # new single-value options
 112         foreach my $p ( qw/ store_path debug / ) {
 113                 $prop->{ $p } ||= undef;
 114                 $template->{ $p } = \$prop->{ $p };
 115         }
 116
 117         # new multi-value options
 118         foreach my $p ( qw/ default_queue / ) {
 119                 $prop->{ $p } ||= [];
 120                 $template->{ $p } = $prop->{ $p };
 121         }
 122 }
 123
 124
 125 =head2 process_request
 126
 127 =cut
 128
 129 sub process_request {
 130         my $self = shift;
 131
 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;
 136
 137         warn "default CPE queue ( " . join(",",@{$prop->{default_queue}}) . " )\n" if defined($prop->{default_queue});
 138
 139         my $session = CWMP::Session->new({
 140                 sock => $sock,
 141                 queue => $prop->{default_queue},
 142                 store_path => $prop->{store_path},
 143                 debug => $prop->{debug},
 144         }) || confess "can't create session";
 145
 146         while ( $session->process_request ) {
 147                 warn "...another one bites the dust...\n";
 148         }
 149
 150         warn "...returning to accepting new connections\n";
 151
 152 }
 153
 154 1;