lib/CWMP/Store.pm

   1 # Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
   2 package CWMP::Store;
   3
   4 use strict;
   5 use warnings;
   6
   7
   8 use base qw/Class::Accessor/;
   9 __PACKAGE__->mk_accessors( qw/
  10 module
  11 path
  12 debug
  13 / );
  14
  15 use Carp qw/confess/;
  16 use Data::Dump qw/dump/;
  17 use Module::Pluggable search_path => 'CWMP::Store', sub_name => 'possible_stores', require => 1;
  18
  19 =head1 NAME
  20
  21 CWMP::Store - parsist CPE state on disk
  22
  23 =head1 METHODS
  24
  25 =head2 new
  26
  27   my $store = CWMP::Store->new({
  28         module => 'DBMDeep',
  29         path => '/path/to/state.db',
  30         clean => 1,
  31         debug => 1,
  32   });
  33
  34 =cut
  35
  36 sub new {
  37         my $class = shift;
  38         my $self = $class->SUPER::new( @_ );
  39
  40         confess "requed parametar module is missing" unless $self->module;
  41
  42         # XXX it's important to call possible_stores once, because current_store won't work
  43         my @plugins = $self->possible_stores();
  44
  45         warn "Found store plugins: ", join(", ", @plugins ), "\n" if $self->debug;
  46
  47         $self->current_store->open( @_ );
  48
  49         return $self;
  50 }
  51
  52 =head2 current_store
  53
  54 Returns currnet store plugin object
  55
  56 =cut
  57
  58 sub current_store {
  59         my $self = shift;
  60
  61         my $module = $self->module;
  62         my $s = $self->only( ref($self).'::'.$module );
  63
  64         confess "unknown store module $module not one of ", dump( $self->possible_stores ) unless $s;
  65
  66         warn "#### current store = $s\n" if $self->debug > 4;
  67
  68         return $s;
  69 }
  70
  71 =head2 update_state
  72
  73   $store->update_state( ID => $ID, $state );
  74   $store->update_state( uid => $uid, $state );
  75
  76 =cut
  77
  78 sub update_state {
  79         my $self = shift;
  80
  81         my ( $k, $v, $state ) = @_;
  82
  83         confess "need ID or uid" unless $k =~ m/^(ID|uid)$/;
  84         confess "need $k value" unless $v;
  85         confess "need state" unless $state;
  86
  87         warn "#### update_state( $k => $v, ", dump( $state ), " )\n" if $self->debug > 4;
  88
  89         my $uid;
  90
  91         if ( $k eq 'ID' ) {
  92                 if ( $uid = $self->ID_to_uid( $v, $state ) ) {
  93                         # nop
  94                 } else {
  95                         warn "## no uid for $v, first seen?\n" if $self->debug;
  96                         return;
  97                 }
  98         } else {
  99                 $uid = $v;
 100         }
 101
 102         $self->current_store->update_uid_state( $uid, $state );
 103 }
 104
 105 =head2 get_state
 106
 107   my $state = $store->get_state( ID => $ID );
 108   my $state = $store->get_state( uid => $uid );
 109
 110 Returns normal unblessed hash (actually, in-memory copy of state in database).
 111
 112 =cut
 113
 114 sub get_state {
 115         my $self = shift;
 116         my ( $k, $v ) = @_;
 117         confess "need ID or uid" unless $k =~ m/^(ID|uid)$/;
 118         confess "need $k value" unless $v;
 119
 120         warn "#### get_state( $k => $v )\n" if $self->debug > 4;
 121
 122         my $uid;
 123
 124         if ( $k eq 'ID' ) {
 125                 if ( $uid = $self->ID_to_uid( $v ) ) {
 126                         # nop
 127                 } else {
 128                         warn "## no uid for $v so no state!\n" if $self->debug;
 129                         return;
 130                 }
 131         } else {
 132                 $uid = $v;
 133         }
 134
 135         return $self->current_store->get_state( $uid );
 136
 137 }
 138
 139 =head2 all_uids
 140
 141   my @cpe = $store->all_uids;
 142
 143 =cut
 144
 145 sub all_uids {
 146         my $self = shift;
 147         my @cpes = $self->current_store->all_uids;
 148         warn "## all_uids = ", dump( @cpes ), "\n" if $self->debug;
 149         return @cpes;
 150 }
 151
 152 =head2 ID_to_uid
 153
 154   my $CPE_uid = $store->ID_to_uid( $ID, $state );
 155
 156 It uses C<< DeviceID.SerialNumber >> from C<Inform> message as unique ID
 157 for each CPE.
 158
 159 =cut
 160
 161 my $session;
 162
 163 sub ID_to_uid {
 164         my $self = shift;
 165         my ( $ID, $state ) = @_;
 166
 167         confess "need ID" unless $ID;
 168
 169         warn "#### ID_to_uid",dump( $ID, $state ),$/ if $self->debug > 4;
 170
 171         $session->{ $ID }->{last_seen} = time();
 172
 173         my $uid;
 174
 175         if ( $uid = $session->{ $ID }->{ ID_to_uid } ) {
 176                 return $uid;
 177         } elsif ( $uid = $state->{DeviceID}->{SerialNumber} ) {
 178                 warn "## created new session for $uid session $ID\n" if $self->debug;
 179                 $session->{ $ID } = {
 180                         last_seen => time(),
 181                         ID_to_uid => $uid,
 182                 };
 183                 return $uid;
 184         } else {
 185                 warn "## can't find uid for ID $ID, first seen?\n";
 186         }
 187
 188         # TODO: expire sessions longer than 30m
 189
 190         return;
 191 }
 192
 193 1;