/[cwmp]/google/trunk/lib/CWMP/Server.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /google/trunk/lib/CWMP/Server.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

google/lib/CWMP/Server.pm revision 83 by dpavlin, Fri Jun 22 15:54:43 2007 UTC google/trunk/lib/CWMP/Server.pm revision 176 by dpavlin, Sun Oct 28 19:44:17 2007 UTC
# Line 4  package CWMP::Server; Line 4  package CWMP::Server;
4  use strict;  use strict;
5  use warnings;  use warnings;
6    
   
7  use base qw/Class::Accessor/;  use base qw/Class::Accessor/;
8  __PACKAGE__->mk_accessors( qw/  __PACKAGE__->mk_accessors( qw/
9  port  port
10  store_path  store
11  default_queue  default_queue
12    background
13  debug  debug
14    
15    server
16  / );  / );
17    
18  use CWMP::Session;  use CWMP::Session;
# Line 28  CWMP::Server - description Line 30  CWMP::Server - description
30    
31    my $server = CWMP::Server->new({    my $server = CWMP::Server->new({
32          port => 3333,          port => 3333,
33          store_path => 'state.db',          store => {
34                    module => 'DBMDeep',
35                    path => 'var/',
36            },
37          default_queue => [ qw/GetRPCMethods GetParameterNames/ ],                                                                    default_queue => [ qw/GetRPCMethods GetParameterNames/ ],                                                          
38            background => 1,
39          debug => 1          debug => 1
40    });    });
41    
# Line 41  Options: Line 47  Options:
47    
48  port to listen on  port to listen on
49    
50  =item store_path  =item store
51    
52  path to L<DBM::Deep> database file to preserve state  hash with key C<module> with value C<DBMDeep> if L<CWMP::Store::DBMDeep>
53    is used. Other parametars are optional.
54    
55  =item default_queue  =item default_queue
56    
# Line 59  sub new { Line 66  sub new {
66    
67          warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;          warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
68    
69            warn "ACS waiting for request on port ", $self->port, "\n";
70    
71            $self->debug( 0 ) unless $self->debug;
72            warn "## debug level: ", $self->debug, "\n" if $self->debug;
73    
74            $self->server(
75                    CWMP::Server::Helper->new({
76                            proto => 'tcp',
77                            port => $self->port,
78                            default_queue => $self->default_queue,
79                            store => $self->store,
80                            debug => $self->debug,
81                            background => $self->background,
82                    })
83            );
84    
85          return $self;          return $self;
86  }  }
87    
88  =head2 run  =head2 run
89    
   $server->run();  
   
90  =cut  =cut
91    
92  sub run {  sub run {
93          my $self = shift;          my $self = shift;
94    
95          my $listen = IO::Socket::INET->new(          $self->server->run;
96                  Listen    => 5,  }
 #               LocalAddr => 'localhost',  
                 LocalPort => $self->port,  
                 Proto     => 'tcp',  
                 Blocking  => 1,  
                 ReuseAddr => 1,  
         );  
97    
98          warn "ACS waiting for request on port ", $self->port;  package CWMP::Server::Helper;
99    
100          $self->debug( 0 ) unless $self->debug;  use warnings;
101          warn "## debug level: ", $self->debug, "\n" if $self->debug;  use strict;
102    
103          warn $self->default_queue ? " queue ( " . join(",",@{$self->default_queue}) . " )" : "",  use base qw/Net::Server/;
104                  "\n";  use Carp qw/confess/;
105    use Data::Dump qw/dump/;
106    
107    sub options {
108            my $self     = shift;
109            my $prop     = $self->{'server'};
110            my $template = shift;
111    
112            ### setup options in the parent classes
113            $self->SUPER::options($template);
114    
115            # new single-value options
116            foreach my $p ( qw/ store debug / ) {
117                    $prop->{ $p } ||= undef;
118                    $template->{ $p } = \$prop->{ $p };
119            }
120    
121            # new multi-value options
122            foreach my $p ( qw/ default_queue / ) {
123                    $prop->{ $p } ||= [];
124                    $template->{ $p } = $prop->{ $p };
125            }
126    }
127    
128    
129    =head2 process_request
130    
131          while ( my $sock = $listen->accept ) {  =cut
132                  $sock->autoflush(1);  
133    sub process_request {
134            my $self = shift;
135    
136            my $prop = $self->{server};
137            confess "no server in ", ref( $self ) unless $prop;
138            my $sock = $prop->{client};
139            confess "no sock in ", ref( $self ) unless $sock;
140    
141            warn "default CPE queue ", dump( $prop->{default_queue} ), "\n" if defined($prop->{default_queue});
142    
143            eval  {
144                  my $session = CWMP::Session->new({                  my $session = CWMP::Session->new({
145                          sock => $sock,                          sock => $sock,
146                          queue => $self->default_queue,                          queue => $prop->{default_queue},
147                          store_path => $self->store_path,                          store => $prop->{store},
148                          debug => $self->debug,                          debug => $prop->{debug},
149                  }) || confess "can't create session";                  }) || confess "can't create session";
150    
151                  while ( $session->process_request ) {                  while ( $session->process_request ) {
152                          warn "...another one bites the dust...\n";                          warn "...waiting for next request from CPE...\n";
153                  }                  }
154            };
155    
156                  warn "...returning to accepting new connections\n";          if ($@) {
157                    warn $@;
158          }          }
159    
160            warn "...returning to accepting new connections\n";
161    
162  }  }
163    
164  1;  1;
Legend:
Removed from v.83  
changed lines
  Added in v.176
  ViewVC Help
Powered by ViewVC 1.1.26