another fix for refresh and report errors

[perl-cwmp.git] / lib / CWMP / Vendor.pm

diff --git a/lib/CWMP/Vendor.pm b/lib/CWMP/Vendor.pm
index f09f120..9613528 100644 (file)
--- a/lib/CWMP/Vendor.pm
+++ b/lib/CWMP/Vendor.pm
@@ -3,11 +3,7 @@ package CWMP::Vendor;
 use strict;
 use warnings;
 
-
-use base qw/Class::Accessor/;
-__PACKAGE__->mk_accessors( qw/
-debug
-/ );
+use YAML qw();
 
 #use Carp qw/confess/;
 use Data::Dump qw/dump/;
@@ -16,108 +12,96 @@ use Data::Dump qw/dump/;
 
 CWMP::Vendor - implement vendor specific logic into ACS server
 
-=head1 METHODS
-
-=head2 new
-
-  my $obj = CWMP::Vendor->new({
-       debug => 1
-  });
-
 =cut
 
-my $debug = 0;
-
-sub new {
-       my $class = shift;
-       my $self = $class->SUPER::new( @_ );
-
-       warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
-
-       $debug = $self->debug;
+my $debug = 1;
 
-       return $self;
-}
-
-my $cpe_faulty;
-
-my $serial2ip = {
-       'CP0636JT3SH' => '192.168.1.242',
-       'CP0644JTHJ4' => '192.168.1.253',
-};
-
-my ( $last_ip, $last_serial );
+sub all_parameters {
+       my ( $self, $store, $uid, $queue ) = @_;
 
-sub state2serial {
-       my $state = shift;
+       my $stored = $store->get_state( $uid );
 
-       my $serial = $state->{DeviceID}->{SerialNumber} || die "no serial?";
-       my $ip = $state->{Parameter}->{'.ExternalIPAddress'} || die "no ip?";
+       return ( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] )
+               if ! defined $stored->{ParameterInfo};
 
-       warn "## state2serial $serial $ip\n" if $debug;
-
-       ( $last_ip, $last_serial ) = ( $ip, $serial );
-
-       return ( $serial, $ip );
-}
+       my @params =
+               grep { m/\.$/ }
+               keys %{ $stored->{ParameterInfo} }
+       ;
 
-sub add_triggers {
+       if ( @params ) {
+               warn "# GetParameterNames ", dump( @params );
+               my $first = shift @params;
+               delete $stored->{ParameterInfo}->{$first};
 
-       warn __PACKAGE__, "->add_triggers\n" if $debug;
-
-CWMP::Request->add_trigger( name => 'Fault', callback => sub {
-       my ( $self, $state ) = @_;
-       warn "## Fault trigger state = ",dump( $self, $state ) if $debug;
-       die "can't map fault to serial!" unless $last_serial;
-       warn "ERROR: got Fault and ingoring $last_ip $last_serial\n";
-       $cpe_faulty->{$last_serial}++;
-});
-
-CWMP::Request->add_trigger( name => 'Inform', callback => sub {
-       my ( $self, $state ) = @_;
-
-       my ( $serial, $ip ) = state2serial( $state );
-
-       if ( $cpe_faulty->{$serial} ) {
-               warn "## Inform trigger from $ip $serial -- IGNORED\n" if $debug;
-               return;
+               foreach ( @params ) {
+                       $queue->enqueue( 'GetParameterNames', [ $_, 1 ] );
+                       delete $stored->{ParameterInfo}->{ $_ };
+               }
+               $store->set_state( $uid, $stored );
+
+               return ( 'GetParameterNames', [ $first, 1 ] );
+
+       } else {
+
+               my @params = sort
+                       grep { ! exists $stored->{Parameter}->{$_} }
+                       grep { ! m/\.$/ && ! m/NumberOfEntries/ }
+                       keys %{ $stored->{ParameterInfo} }
+               ;
+               if ( @params ) {
+                       warn "# GetParameterValues ", dump( @params );
+                       my $first = shift @params;
+                       while ( @params ) {
+                               my @chunk = splice @params, 0, 16; # FIXME 16 seems to be max
+                               $queue->enqueue( 'GetParameterValues', [ @chunk ] );
+                       }
+
+                       return ( 'GetParameterValues', [ $first ] );
+               }
        }
 
-       warn "## Inform trigger from $ip $serial\n" if $debug;
-
-       my $found = 0;
-
-       warn "### serial2ip = ",dump( $serial2ip ) if $debug;
-
-       foreach my $target_serial ( keys %$serial2ip ) {
-
-               next unless $target_serial eq $serial;
-
-               $found++;
+       return;
+}
 
-               my $target_ip = $serial2ip->{$target_serial};
+our $tried;
 
-               if ( $ip ne $target_ip ) {
+sub vendor_config {
+       my ( $self, $store, $uid, $queue ) = @_;
 
-                       warn "CHANGE IP $ip to $target_ip for $serial\n";
+       my $stored = $store->get_state( $uid );
 
-                       return; # FIXME
+       my @refresh;
 
-                       my $q = CWMP::Queue->new({ id => $serial, debug => $debug }) || die "no queue?";
+       my $vendor = YAML::LoadFile 'vendor.yaml';
+       $vendor = $vendor->{Parameter} || die  "no Parameter in vendor.yaml";
+       $stored = $stored->{Parameter} || warn "no Parameter in stored ", dump($stored);
 
-                       $q->enqueue( 'SetParameterValues', {
-                               'InternetGatewayDevice.LANDevice.1.LANHostConfigManagement.IPInterface.1.IPInterfaceIPAddress' => $target_ip,
-                       });
+       warn "# vendor.yaml ",dump $vendor;
 
+       foreach my $n ( keys %$vendor ) {
+               if ( ! exists $stored->{$n} ) {
+                       warn "# $uid missing $n\n";
+                       push @refresh, $n;
+               } elsif ( $vendor->{$n} ne $stored->{$n}
+                       && ( ! $tried->{$uid}->{$n}->{set} || $tried->{$uid}->{$n}->{set} ne $vendor->{$n} )
+               ) {
+                       $queue->enqueue( 'SetParameterValues', { $n => $vendor->{$n} } );
+                       push @refresh, $n;
+                       $tried->{$uid}->{$n}->{set} = $vendor->{$n};
+                       warn "# set $uid $n $stored->{$n} -> $vendor->{$n}\n";
+               } elsif ( $tried->{$uid}->{$n}->{set} eq $vendor->{$n} && $vendor->{$n} ne $stored->{$n} ) {
+                       warn "ERROR $uid $n $stored->{$n} != $vendor->{$n}\n";
                } else {
-                       warn "IP $ip of $serial ok\n";
+                       warn "# ok $uid $n = $stored->{$n}\n";
                }
        }
 
-       warn "UNKNOWN CPE $ip $serial\nadd\t'$serial' => '$ip',\n" unless $found;
+       return ( 'GetParameterValues', [ @refresh ] ) if @refresh;
 
-});
+       warn "# tried ",dump $tried;
 
-}#add_triggers
+       return;
+}
 
 1;