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