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 debug
  11 path
  12
  13 db
  14 / );
  15
  16 use Carp qw/confess/;
  17 use Data::Dump qw/dump/;
  18 use DBM::Deep;
  19
  20 =head1 NAME
  21
  22 CWMP::Store - parsist CPE state on disk
  23
  24 =head1 METHODS
  25
  26 =head2 new
  27
  28   my $store = CWMP::Store->new({
  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         warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
  40
  41         confess "need path to state.db" unless ( $self->path );
  42
  43         $self->db(
  44                 DBM::Deep->new(
  45                         file => $self->path,
  46                         locking => 1,
  47                         autoflush => 1,
  48                 )
  49         );
  50
  51         foreach my $init ( qw/ state session / ) {
  52                 $self->db->put( $init => {} ) unless $self->db->get( $init );
  53         }
  54
  55         return $self;
  56 }
  57
  58 =head2 update_state
  59
  60   $store->update_state( ID => $ID, $state );
  61   $store->update_state( uid => $uid, $state );
  62
  63 =cut
  64
  65 sub update_state {
  66         my $self = shift;
  67
  68         my ( $k, $v, $state ) = @_;
  69
  70         confess "need ID or uid" unless $k =~ m/^(ID|uid)$/;
  71         confess "need $k value" unless $v;
  72         confess "need state" unless $state;
  73
  74         warn "## update_state( $k => $v, ", dump( $state ), " )\n" if $self->debug;
  75
  76         my $uid;
  77
  78         if ( $k eq 'ID' ) {
  79                 if ( $uid = $self->ID_to_uid( $v, $state ) ) {
  80                         # nop
  81                 } else {
  82                         warn "## no uid for $v, first seen?\n" if $self->debug;
  83                         return;
  84                 }
  85         } else {
  86                 $uid = $v;
  87         }
  88
  89         if ( my $o = $self->db->get('state')->get( $uid ) ) {
  90                 warn "## update state of $uid [$v]\n" if $self->debug;
  91                 return $o->import( $state );
  92         } else {
  93                 warn "## create new state for $uid [$v]\n" if $self->debug;
  94                 return $self->db->get('state')->put( $uid => $state );
  95         }
  96 }
  97
  98 =head2 state
  99
 100   my $state = $store->state( ID => $ID );
 101   my $state = $store->state( uid => $uid );
 102
 103 Returns normal unblessed hash (actually, in-memory copy of state in database).
 104
 105 =cut
 106
 107 sub state {
 108         my $self = shift;
 109         my ( $k, $v ) = @_;
 110         confess "need ID or uid" unless $k =~ m/^(ID|uid)$/;
 111         confess "need $k value" unless $v;
 112
 113         warn "## state( $k => $v )\n" if $self->debug;
 114
 115         my $uid;
 116
 117         if ( $k eq 'ID' ) {
 118                 if ( $uid = $self->ID_to_uid( $v ) ) {
 119                         # nop
 120                 } else {
 121                         warn "## no uid for $v so no state!\n" if $self->debug;
 122                         return;
 123                 }
 124         } else {
 125                 $uid = $v;
 126         }
 127
 128         if ( my $state = $self->db->get('state')->get( $uid ) ) {
 129                 return $state->export;
 130         } else {
 131                 return;
 132         }
 133
 134 }
 135
 136 =head2 known_CPE
 137
 138   my @cpe = $store->known_CPE;
 139
 140 =cut
 141
 142 sub known_CPE {
 143         my $self = shift;
 144         my @cpes = keys %{ $self->db->{state} };
 145         warn "all CPE: ", dump( @cpes ), "\n" if $self->debug;
 146         return @cpes;
 147 }
 148
 149 =head2 ID_to_uid
 150
 151   my $CPE_uid = $store->ID_to_uid( $ID, $state );
 152
 153 It uses C<< DeviceID.SerialNumber >> from C<Inform> message as unique ID
 154 for each CPE.
 155
 156 =cut
 157
 158 sub ID_to_uid {
 159         my $self = shift;
 160         my ( $ID, $state ) = @_;
 161
 162         confess "need ID" unless $ID;
 163
 164         warn "ID_to_uid",dump( $ID, $state ),$/ if $self->debug;
 165
 166         $self->db->{session}->{ $ID }->{last_seen} = time();
 167
 168         my $uid;
 169
 170         if ( $uid = $self->db->{session}->{ $ID }->{ ID_to_uid } ) {
 171                 return $uid;
 172         } elsif ( $uid = $state->{DeviceID}->{SerialNumber} ) {
 173                 warn "## created new session for $uid session $ID\n" if $self->debug;
 174                 $self->db->{session}->{ $ID } = {
 175                         last_seen => time(),
 176                         ID_to_uid => $uid,
 177                 };
 178                 return $uid;
 179         } else {
 180                 warn "## can't find uid for ID $ID, first seen?\n";
 181                 return;
 182         }
 183
 184         # TODO: expire sessions longer than 30m
 185
 186         return;
 187 }
 188
 189 1;