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