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 Carp qw/confess/;
  96 use Data::Dump qw/dump/;
  97
  98 sub options {
  99         my $self     = shift;
 100         my $prop     = $self->{'server'};
 101         my $template = shift;
 102
 103         ### setup options in the parent classes
 104         $self->SUPER::options($template);
 105
 106         # new single-value options
 107         foreach my $p ( qw/ session debug / ) {
 108                 $prop->{ $p } ||= undef;
 109                 $template->{ $p } = \$prop->{ $p };
 110         }
 111
 112         # new multi-value options
 113 #       foreach my $p ( qw/ default_queue / ) {
 114 #               $prop->{ $p } ||= [];
 115 #               $template->{ $p } = $prop->{ $p };
 116 #       }
 117 }
 118
 119
 120 =head2 process_request
 121
 122 =cut
 123
 124 sub process_request {
 125         my $self = shift;
 126
 127         my $prop = $self->{server};
 128         confess "no server in ", ref( $self ) unless $prop;
 129         my $sock = $prop->{client};
 130         confess "no sock in ", ref( $self ) unless $sock;
 131
 132         my $sess = $prop->{session} || confess "no session";
 133
 134         eval  {
 135                 $sess->{sock} = $sock;
 136                 $sess->{debug} = $prop->{debug};
 137
 138                 warn "## sess = ", dump( $sess );
 139
 140                 my $session = CWMP::Session->new( $sess ) || confess "can't create session from ",dump( $sess );
 141
 142                 while ( $session->process_request ) {
 143                         warn "...waiting for next request from CPE...\n";
 144                 }
 145         };
 146
 147         warn "ERROR: $@\n" if $@;
 148
 149         warn "...returning to accepting new connections\n";
 150
 151 }
 152
 153 1;