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 use CWMP::MemLeak;
  20
  21 use Carp qw/confess/;
  22 use Data::Dump qw/dump/;
  23
  24 =head1 NAME
  25
  26 CWMP::Server - description
  27
  28 =head1 METHODS
  29
  30 =head2 new
  31
  32   my $server = CWMP::Server->new({
  33         port => 3333,
  34         session => { ... },
  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 session
  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 =back
  53
  54 =cut
  55
  56 sub new {
  57         my $class = shift;
  58         my $self = $class->SUPER::new( @_ );
  59
  60         warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
  61
  62         warn "ACS waiting for request on port ", $self->port, "\n";
  63
  64         $self->debug( 0 ) unless $self->debug;
  65         warn "## debug level: ", $self->debug, "\n" if $self->debug;
  66
  67         $self->server(
  68                 CWMP::Server::Helper->new({
  69                         proto => 'tcp',
  70                         port => $self->port,
  71                         session => $self->session,
  72                         debug => $self->debug,
  73                         background => $self->background,
  74                 })
  75         );
  76
  77         return $self;
  78 }
  79
  80 =head2 run
  81
  82 =cut
  83
  84 sub run {
  85         my $self = shift;
  86
  87         $self->server->run;
  88 }
  89
  90 package CWMP::Server::Helper;
  91
  92 use warnings;
  93 use strict;
  94
  95 use base qw/Net::Server/;
  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 $leak = CWMP::MemLeak->new;
 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         my $sess = $prop->{session} || confess "no session";
 136
 137         eval  {
 138                 $sess->{sock} = $sock;
 139                 $sess->{debug} = $prop->{debug};
 140
 141                 my $session = CWMP::Session->new( $sess ) || confess "can't create session from ",dump( $sess );
 142
 143                 while ( $session->process_request ) {
 144                         warn "...waiting for next request from CPE...\n" if $prop->{debug};
 145                 }
 146         };
 147
 148         warn "ERROR: $@\n" if $@;
 149
 150         warn "...returning to accepting new connections\n" if $prop->{debug};
 151
 152         $leak->report;
 153
 154 }
 155
 156 1;