lib/CWMP/Store.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
package CWMP::Store;

use strict;
use warnings;


use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors( qw/
module
path
debug
/ );

use Carp qw/confess/;
use Data::Dump qw/dump/;
use Module::Pluggable search_path => 'CWMP::Store', sub_name => 'possible_stores', require => 1;

=head1 NAME

CWMP::Store - parsist CPE state on disk

=head1 METHODS

=head2 new

  my $store = CWMP::Store->new({
        module => 'DBMDeep',
        path => '/path/to/state.db',
        clean => 1,
        debug => 1,
  });

=cut

sub new {
        my $class = shift;
        my $self = $class->SUPER::new( @_ );

        confess "requed parametar module is missing" unless $self->module;

        # XXX it's important to call possible_stores once, because current_store won't work
        my @plugins = $self->possible_stores();

        warn "Found store plugins: ", join(", ", @plugins ), "\n" if $self->debug;

        $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 );

=cut

sub update_state {
        my $self = shift;

        my ( $k, $v, $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 > 4;

        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;
        }

        $self->current_store->update_uid_state( $uid, $state );
}

=head2 get_state

  my $state = $store->get_state( ID => $ID );
  my $state = $store->get_state( uid => $uid );

Returns normal unblessed hash (actually, in-memory copy of state in database).

=cut

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 "#### get_state( $k => $v )\n" if $self->debug > 4;

        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;
        }

        return $self->current_store->get_state( $uid );

}

=head2 all_uids

  my @cpe = $store->all_uids;

=cut

sub all_uids {
        my $self = shift;
        my @cpes = $self->current_store->all_uids;
        warn "## all_uids = ", dump( @cpes ), "\n" if $self->debug;
        return @cpes;
}

=head2 ID_to_uid

  my $CPE_uid = $store->ID_to_uid( $ID, $state );

It uses C<< DeviceID.SerialNumber >> from C<Inform> message as unique ID
for each CPE.

=cut

my $session;

sub ID_to_uid {
        my $self = shift;
        my ( $ID, $state ) = @_;

        confess "need ID" unless $ID;

        warn "#### ID_to_uid",dump( $ID, $state ),$/ if $self->debug > 4;

        $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";
        }

        # TODO: expire sessions longer than 30m

        return;
}

1;
1	dpavlin	77	# 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	dpavlin	150	module
11			path
12	dpavlin	77	debug
13			/ );
14
15	dpavlin	79	use Carp qw/confess/;
16	dpavlin	77	use Data::Dump qw/dump/;
17	dpavlin	150	use Module::Pluggable search_path => 'CWMP::Store', sub_name => 'possible_stores', require => 1;
18	dpavlin	77
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	dpavlin	150	module => 'DBMDeep',
29	dpavlin	77	path => '/path/to/state.db',
30	dpavlin	162	clean => 1,
31	dpavlin	77	debug => 1,
32			});
33
34			=cut
35
36			sub new {
37			my $class = shift;
38			my $self = $class->SUPER::new( @_ );
39
40	dpavlin	150	confess "requed parametar module is missing" unless $self->module;
41
42	dpavlin	162	# XXX it's important to call possible_stores once, because current_store won't work
43			my @plugins = $self->possible_stores();
44	dpavlin	77
45	dpavlin	162	warn "Found store plugins: ", join(", ", @plugins ), "\n" if $self->debug;
46	dpavlin	84
47	dpavlin	150	$self->current_store->open( @_ );
48	dpavlin	77
49	dpavlin	170	# so that we don't have to check if it's defined
50			$self->debug( 0 ) unless $self->debug;
51
52	dpavlin	77	return $self;
53			}
54
55	dpavlin	150	=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	dpavlin	172	# warn "#### current store = $s\n" if $self->debug > 4;
70	dpavlin	150
71			return $s;
72			}
73
74	dpavlin	79	=head2 update_state
75	dpavlin	77
76	dpavlin	100	$store->update_state( ID => $ID, $state );
77			$store->update_state( uid => $uid, $state );
78	dpavlin	79
79			=cut
80
81			sub update_state {
82			my $self = shift;
83
84	dpavlin	100	my ( $k, $v, $state ) = @_;
85	dpavlin	79
86	dpavlin	100	confess "need ID or uid" unless $k =~ m/^(ID\|uid)$/;
87			confess "need $k value" unless $v;
88	dpavlin	79	confess "need state" unless $state;
89
90	dpavlin	169	warn "#### update_state( $k => $v, ", dump( $state ), " )\n" if $self->debug > 4;
91	dpavlin	100
92			my $uid;
93
94			if ( $k eq 'ID' ) {
95			if ( $uid = $self->ID_to_uid( $v, $state ) ) {
96			# nop
97	dpavlin	95	} else {
98	dpavlin	100	warn "## no uid for $v, first seen?\n" if $self->debug;
99			return;
100	dpavlin	95	}
101	dpavlin	81	} else {
102	dpavlin	100	$uid = $v;
103	dpavlin	81	}
104	dpavlin	100
105	dpavlin	150	$self->current_store->update_uid_state( $uid, $state );
106	dpavlin	79	}
107	dpavlin	85
108	dpavlin	162	=head2 get_state
109	dpavlin	85
110	dpavlin	162	my $state = $store->get_state( ID => $ID );
111			my $state = $store->get_state( uid => $uid );
112	dpavlin	85
113			Returns normal unblessed hash (actually, in-memory copy of state in database).
114
115			=cut
116
117	dpavlin	162	sub get_state {
118	dpavlin	85	my $self = shift;
119	dpavlin	100	my ( $k, $v ) = @_;
120			confess "need ID or uid" unless $k =~ m/^(ID\|uid)$/;
121			confess "need $k value" unless $v;
122
123	dpavlin	169	warn "#### get_state( $k => $v )\n" if $self->debug > 4;
124	dpavlin	100
125			my $uid;
126
127			if ( $k eq 'ID' ) {
128			if ( $uid = $self->ID_to_uid( $v ) ) {
129			# nop
130	dpavlin	95	} else {
131	dpavlin	100	warn "## no uid for $v so no state!\n" if $self->debug;
132	dpavlin	95	return;
133			}
134			} else {
135	dpavlin	100	$uid = $v;
136			}
137
138	dpavlin	150	return $self->current_store->get_state( $uid );
139	dpavlin	100
140	dpavlin	85	}
141
142	dpavlin	162	=head2 all_uids
143	dpavlin	95
144	dpavlin	162	my @cpe = $store->all_uids;
145	dpavlin	95
146			=cut
147
148	dpavlin	162	sub all_uids {
149	dpavlin	95	my $self = shift;
150	dpavlin	150	my @cpes = $self->current_store->all_uids;
151	dpavlin	162	warn "## all_uids = ", dump( @cpes ), "\n" if $self->debug;
152	dpavlin	95	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	dpavlin	149	my $session;
165
166	dpavlin	95	sub ID_to_uid {
167			my $self = shift;
168			my ( $ID, $state ) = @_;
169
170			confess "need ID" unless $ID;
171
172	dpavlin	169	warn "#### ID_to_uid",dump( $ID, $state ),$/ if $self->debug > 4;
173	dpavlin	95
174	dpavlin	149	$session->{ $ID }->{last_seen} = time();
175	dpavlin	95
176			my $uid;
177
178	dpavlin	149	if ( $uid = $session->{ $ID }->{ ID_to_uid } ) {
179	dpavlin	95	return $uid;
180			} elsif ( $uid = $state->{DeviceID}->{SerialNumber} ) {
181			warn "## created new session for $uid session $ID\n" if $self->debug;
182	dpavlin	149	$session->{ $ID } = {
183	dpavlin	95	last_seen => time(),
184			ID_to_uid => $uid,
185			};
186			return $uid;
187			} else {
188			warn "## can't find uid for ID $ID, first seen?\n";
189			}
190
191			# TODO: expire sessions longer than 30m
192
193			return;
194			}
195
196	dpavlin	77	1;