X-Git-Url: http://git.rot13.org/?p=perl-cwmp.git;a=blobdiff_plain;f=lib%2FCWMP%2FStore.pm;h=6d9a784bd78e4d12dd57f82bc5b5c03e2ec56cc5;hp=8425ec270b363ffea5371ad039d1d49512169e9d;hb=73114373a890391990bba21f0b4eadb18a4a859b;hpb=8ddfa88afea617dc8546f10313026d51fb79a926 diff --git a/lib/CWMP/Store.pm b/lib/CWMP/Store.pm index 8425ec2..6d9a784 100644 --- a/lib/CWMP/Store.pm +++ b/lib/CWMP/Store.pm @@ -7,15 +7,14 @@ use warnings; use base qw/Class::Accessor/; __PACKAGE__->mk_accessors( qw/ -debug +module path - -db +debug / ); use Carp qw/confess/; use Data::Dump qw/dump/; -use DBM::Deep; +use Module::Pluggable search_path => 'CWMP::Store', sub_name => 'possible_stores', require => 1; =head1 NAME @@ -26,7 +25,9 @@ CWMP::Store - parsist CPE state on disk =head2 new my $store = CWMP::Store->new({ + module => 'DBMDeep', path => '/path/to/state.db', + clean => 1, debug => 1, }); @@ -36,154 +37,110 @@ sub new { my $class = shift; my $self = $class->SUPER::new( @_ ); - warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug; + confess "requed parametar module is missing" unless $self->module; - confess "need path to state.db" unless ( $self->path ); + # XXX it's important to call possible_stores once, because current_store won't work + my @plugins = $self->possible_stores(); - $self->db( - DBM::Deep->new( - file => $self->path, - locking => 1, - autoflush => 1, - ) - ); + warn "Found store plugins: ", join(", ", @plugins ), "\n" if $self->debug; - foreach my $init ( qw/ state session / ) { - $self->db->put( $init => {} ) unless $self->db->get( $init ); - } + $self->current_store->open( @_ ); + + # so that we don't have to check if it's defined + $self->debug( 0 ) unless $self->debug; return $self; } +=head2 current_store + +Returns currnet store plugin object + +=cut + +sub current_store { + my $self = shift; + + my $module = $self->module; + my $s = $self->only( ref($self).'::'.$module ); + + confess "unknown store module $module not one of ", dump( $self->possible_stores ) unless $s; + +# warn "#### current store = $s\n" if $self->debug > 4; + + return $s; +} + =head2 update_state - $store->update_state( ID => $ID, $state ); - $store->update_state( uid => $uid, $state ); + $store->update_state( $state ); =cut sub update_state { my $self = shift; - my ( $k, $v, $state ) = @_; + my ( $state ) = @_; - confess "need ID or uid" unless $k =~ m/^(ID|uid)$/; - confess "need $k value" unless $v; confess "need state" unless $state; - warn "## update_state( $k => $v, ", dump( $state ), " )\n" if $self->debug; - - my $uid; - - if ( $k eq 'ID' ) { - if ( $uid = $self->ID_to_uid( $v, $state ) ) { - # nop - } else { - warn "## no uid for $v, first seen?\n" if $self->debug; - return; - } - } else { - $uid = $v; - } - - if ( my $o = $self->db->get('state')->get( $uid ) ) { - warn "## update state of $uid [$v]\n" if $self->debug; - return $o->import( $state ); - } else { - warn "## create new state for $uid [$v]\n" if $self->debug; - return $self->db->get('state')->put( $uid => $state ); - } + my $uid = $self->state_to_uid( $state ); + + warn "#### update_state( ", dump( $state ), " ) for $uid\n" if $self->debug > 2; + $self->current_store->update_uid_state( $uid, $state ); } -=head2 state +=head2 get_state - my $state = $store->state( ID => $ID ); - my $state = $store->state( uid => $uid ); + my $state = $store->get_state( $uid ); Returns normal unblessed hash (actually, in-memory copy of state in database). =cut -sub state { +sub get_state { my $self = shift; - my ( $k, $v ) = @_; - confess "need ID or uid" unless $k =~ m/^(ID|uid)$/; - confess "need $k value" unless $v; - - warn "## state( $k => $v )\n" if $self->debug; - - my $uid; - - if ( $k eq 'ID' ) { - if ( $uid = $self->ID_to_uid( $v ) ) { - # nop - } else { - warn "## no uid for $v so no state!\n" if $self->debug; - return; - } - } else { - $uid = $v; - } - - if ( my $state = $self->db->get('state')->get( $uid ) ) { - return $state->export; - } else { - return; - } + my ( $uid ) = @_; + confess "need uid" unless $uid; + + warn "#### get_state( $uid )\n" if $self->debug > 4; + + return $self->current_store->get_state( $uid ); } -=head2 known_CPE +=head2 all_uids - my @cpe = $store->known_CPE; + my @cpe = $store->all_uids; =cut -sub known_CPE { +sub all_uids { my $self = shift; - my @cpes = keys %{ $self->db->{state} }; - warn "all CPE: ", dump( @cpes ), "\n" if $self->debug; + my @cpes = $self->current_store->all_uids; + warn "## all_uids = ", dump( @cpes ), "\n" if $self->debug; return @cpes; } -=head2 ID_to_uid +=head2 state_to_uid - my $CPE_uid = $store->ID_to_uid( $ID, $state ); + my $CPE_uid = $store->ID_to_uid( $state ); It uses C<< DeviceID.SerialNumber >> from C message as unique ID for each CPE. =cut -sub ID_to_uid { +sub state_to_uid { my $self = shift; - my ( $ID, $state ) = @_; - - confess "need ID" unless $ID; - - warn "ID_to_uid",dump( $ID, $state ),$/ if $self->debug; - - $self->db->{session}->{ $ID }->{last_seen} = time(); - - my $uid; + my ( $state ) = @_; - if ( $uid = $self->db->{session}->{ $ID }->{ ID_to_uid } ) { - return $uid; - } elsif ( $uid = $state->{DeviceID}->{SerialNumber} ) { - warn "## created new session for $uid session $ID\n" if $self->debug; - $self->db->{session}->{ $ID } = { - last_seen => time(), - ID_to_uid => $uid, - }; - return $uid; - } else { - warn "## can't find uid for ID $ID, first seen?\n"; - return; - } + warn "#### state_to_uid",dump( $state ),$/ if $self->debug > 4; - # TODO: expire sessions longer than 30m + my $uid = $state->{DeviceID}->{SerialNumber} || + confess "no DeviceID.SerialNumber in ",dump( $state ); - return; + return $uid; } 1;