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
=head2 new
my $store = CWMP::Store->new({
+ module => 'DBMDeep',
path => '/path/to/state.db',
+ clean => 1,
debug => 1,
});
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 / ) {
- $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<Inform> message as unique ID
for each CPE.
=cut
-my $session;
-
-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;
-
- $session->{ $ID }->{last_seen} = time();
-
- my $uid;
-
- if ( $uid = $session->{ $ID }->{ ID_to_uid } ) {
- return $uid;
- } elsif ( $uid = $state->{DeviceID}->{SerialNumber} ) {
- warn "## created new session for $uid session $ID\n" if $self->debug;
- $session->{ $ID } = {
- last_seen => time(),
- ID_to_uid => $uid,
- };
- return $uid;
- } else {
- warn "## can't find uid for ID $ID, first seen?\n";
- return;
- }
+ my ( $state ) = @_;
- # TODO: expire sessions longer than 30m
+ warn "#### state_to_uid",dump( $state ),$/ if $self->debug > 4;
- warn "current session = ",dump( $session );
+ my $uid = $state->{DeviceID}->{SerialNumber} ||
+ confess "no DeviceID.SerialNumber in ",dump( $state );
- return;
+ return $uid;
}
1;
projects / perl-cwmp.git / blobdiff