fix CWMP::Vendor->vendor_config
[perl-cwmp.git] / lib / CWMP / Vendor.pm
1 package CWMP::Vendor;
2
3 use strict;
4 use warnings;
5
6 use YAML qw();
7
8 #use Carp qw/confess/;
9 use Data::Dump qw/dump/;
10
11 =head1 NAME
12
13 CWMP::Vendor - implement vendor specific logic into ACS server
14
15 =cut
16
17 my $debug = 1;
18
19 sub all_parameters {
20         my ( $self, $store, $uid, $queue ) = @_;
21
22         my $stored = $store->get_state( $uid );
23
24         return ( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] )
25                 if ! defined $stored->{ParameterInfo};
26
27         my @params =
28                 grep { m/\.$/ }
29                 keys %{ $stored->{ParameterInfo} }
30         ;
31
32         if ( @params ) {
33                 warn "# GetParameterNames ", dump( @params );
34                 my $first = shift @params;
35                 delete $stored->{ParameterInfo}->{$first};
36
37                 foreach ( @params ) {
38                         $queue->enqueue( 'GetParameterNames', [ $_, 1 ] );
39                         delete $stored->{ParameterInfo}->{ $_ };
40                 }
41                 $store->set_state( $uid, $stored );
42
43                 return ( 'GetParameterNames', [ $first, 1 ] );
44
45         } else {
46
47                 my @params = sort
48                         grep { ! exists $stored->{Parameter}->{$_} }
49                         grep { ! m/\.$/ && ! m/NumberOfEntries/ }
50                         keys %{ $stored->{ParameterInfo} }
51                 ;
52                 if ( @params ) {
53                         warn "# GetParameterValues ", dump( @params );
54                         my $first = shift @params;
55                         while ( @params ) {
56                                 my @chunk = splice @params, 0, 16; # FIXME 16 seems to be max
57                                 $queue->enqueue( 'GetParameterValues', [ @chunk ] );
58                         }
59
60                         return ( 'GetParameterValues', [ $first ] );
61                 }
62         }
63
64         return;
65 }
66
67 our $tried;
68
69 sub vendor_config {
70         my ( $self, $store, $uid, $queue ) = @_;
71
72         my $stored = $store->get_state( $uid );
73
74         my @refresh;
75
76         my $vendor = YAML::LoadFile 'vendor.yaml';
77         $vendor = $vendor->{Parameter} || die  "no Parameter in vendor.yaml";
78         $stored = $stored->{Parameter} || warn "no Parameter in stored ", dump($stored);
79
80         warn "# vendor.yaml ",dump $vendor;
81
82         foreach my $n ( keys %$vendor ) {
83                 if ( ! exists $stored->{$n} ) {
84                         warn "# $uid missing $n\n";
85                         push @refresh, $n;
86                 } elsif ( $vendor->{$n} ne $stored->{$n} ) {
87                         $queue->enqueue( 'SetParameterValues', { $n => $vendor->{$n} } )
88                                 unless $tried->{$uid}->{$n}->{set}++;
89                         warn "# set $uid $n $stored->{$n} -> $vendor->{$n}\n";
90                 } else {
91                         warn "# ok $uid $n\n";
92                 }
93         }
94
95         if ( @refresh ) {
96                 $queue->enqueue( 'GetParameterValues', [ @refresh ] );
97                 warn "vendor_hook $uid SetParameterValues ", dump( @refresh );
98                 return ( 'GetParameterValues', [ @refresh ] );
99         }
100
101         warn "# tried ",dump $tried;
102
103         return;
104 }
105
106 1;