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