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         # so that we don't have to check if it's defined
  50         $self->debug( 0 ) unless $self->debug;
  51
  52         return $self;
  53 }
  54
  55 =head2 current_store
  56
  57 Returns currnet store plugin object
  58
  59 =cut
  60
  61 sub current_store {
  62         my $self = shift;
  63
  64         my $module = $self->module;
  65         my $s = $self->only( ref($self).'::'.$module );
  66
  67         confess "unknown store module $module not one of ", dump( $self->possible_stores ) unless $s;
  68
  69 #       warn "#### current store = $s\n" if $self->debug > 4;
  70
  71         return $s;
  72 }
  73
  74 =head2 update_state
  75
  76   $store->update_state( ID => $ID, $state );
  77   $store->update_state( uid => $uid, $state );
  78
  79 =cut
  80
  81 sub update_state {
  82         my $self = shift;
  83
  84         my ( $k, $v, $state ) = @_;
  85
  86         confess "need ID or uid" unless $k =~ m/^(ID|uid)$/;
  87         confess "need $k value" unless $v;
  88         confess "need state" unless $state;
  89
  90         warn "#### update_state( $k => $v, ", dump( $state ), " )\n" if $self->debug > 4;
  91
  92         my $uid;
  93
  94         if ( $k eq 'ID' ) {
  95                 if ( $uid = $self->ID_to_uid( $v, $state ) ) {
  96                         # nop
  97                 } else {
  98                         warn "## no uid for $v, first seen?\n" if $self->debug;
  99                         return;
 100                 }
 101         } else {
 102                 $uid = $v;
 103         }
 104
 105         $self->current_store->update_uid_state( $uid, $state );
 106 }
 107
 108 =head2 get_state
 109
 110   my $state = $store->get_state( ID => $ID );
 111   my $state = $store->get_state( uid => $uid );
 112
 113 Returns normal unblessed hash (actually, in-memory copy of state in database).
 114
 115 =cut
 116
 117 sub get_state {
 118         my $self = shift;
 119         my ( $k, $v ) = @_;
 120         confess "need ID or uid" unless $k =~ m/^(ID|uid)$/;
 121         confess "need $k value" unless $v;
 122
 123         warn "#### get_state( $k => $v )\n" if $self->debug > 4;
 124
 125         my $uid;
 126
 127         if ( $k eq 'ID' ) {
 128                 if ( $uid = $self->ID_to_uid( $v ) ) {
 129                         # nop
 130                 } else {
 131                         warn "## no uid for $v so no state!\n" if $self->debug;
 132                         return;
 133                 }
 134         } else {
 135                 $uid = $v;
 136         }
 137
 138         return $self->current_store->get_state( $uid );
 139
 140 }
 141
 142 =head2 all_uids
 143
 144   my @cpe = $store->all_uids;
 145
 146 =cut
 147
 148 sub all_uids {
 149         my $self = shift;
 150         my @cpes = $self->current_store->all_uids;
 151         warn "## all_uids = ", dump( @cpes ), "\n" if $self->debug;
 152         return @cpes;
 153 }
 154
 155 =head2 ID_to_uid
 156
 157   my $CPE_uid = $store->ID_to_uid( $ID, $state );
 158
 159 It uses C<< DeviceID.SerialNumber >> from C<Inform> message as unique ID
 160 for each CPE.
 161
 162 =cut
 163
 164 my $session;
 165
 166 sub ID_to_uid {
 167         my $self = shift;
 168         my ( $ID, $state ) = @_;
 169
 170         confess "need ID" unless $ID;
 171
 172         warn "#### ID_to_uid",dump( $ID, $state ),$/ if $self->debug > 4;
 173
 174         warn "##### current session = ",dump( $session ), $/ if $self->debug > 5;
 175
 176         $session->{ $ID }->{last_seen} = time();
 177
 178         my $uid;
 179
 180         if ( $uid = $session->{ $ID }->{ ID_to_uid } ) {
 181                 return $uid;
 182         } elsif ( $uid = $state->{DeviceID}->{SerialNumber} ) {
 183                 warn "## created new session for $uid session $ID\n" if $self->debug;
 184                 $session->{ $ID } = {
 185                         last_seen => time(),
 186                         ID_to_uid => $uid,
 187                 };
 188                 return $uid;
 189         } else {
 190                 warn "## can't find uid for ID $ID, first seen?\n";
 191         }
 192
 193         # TODO: expire sessions longer than 30m
 194
 195         return;
 196 }
 197
 198 1;