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/
debug
path

db
/ );

use Carp qw/confess/;
use Data::Dump qw/dump/;
use DBM::Deep;

=head1 NAME

CWMP::Store - parsist CPE state on disk

=head1 METHODS

=head2 new

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

=cut

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

        warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;

        confess "need path to state.db" unless ( $self->path );

        $self->db(
                DBM::Deep->new(
                        file => $self->path,
                        locking => 1,
                        autoflush => 1,
                )
        );

        foreach my $init ( qw/ state / ) {
                $self->db->put( $init => {} ) unless $self->db->get( $init );
        }

        return $self;
}

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

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

=head2 state

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

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

=cut

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

}

=head2 known_CPE

  my @cpe = $store->known_CPE;

=cut

sub known_CPE {
        my $self = shift;
        my @cpes = keys %{ $self->db->{state} };
        warn "all CPE: ", 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;

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

        # TODO: expire sessions longer than 30m

        warn "current session = ",dump( $session );

        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			debug
11			path
12
13	dpavlin	79	db
14	dpavlin	77	/ );
15
16	dpavlin	79	use Carp qw/confess/;
17	dpavlin	77	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	dpavlin	84	confess "need path to state.db" unless ( $self->path );
42
43	dpavlin	79	$self->db(
44	dpavlin	77	DBM::Deep->new(
45			file => $self->path,
46			locking => 1,
47			autoflush => 1,
48			)
49			);
50
51	dpavlin	149	foreach my $init ( qw/ state / ) {
52	dpavlin	95	$self->db->put( $init => {} ) unless $self->db->get( $init );
53			}
54
55	dpavlin	77	return $self;
56			}
57
58	dpavlin	79	=head2 update_state
59	dpavlin	77
60	dpavlin	100	$store->update_state( ID => $ID, $state );
61			$store->update_state( uid => $uid, $state );
62	dpavlin	79
63			=cut
64
65			sub update_state {
66			my $self = shift;
67
68	dpavlin	100	my ( $k, $v, $state ) = @_;
69	dpavlin	79
70	dpavlin	100	confess "need ID or uid" unless $k =~ m/^(ID\|uid)$/;
71			confess "need $k value" unless $v;
72	dpavlin	79	confess "need state" unless $state;
73
74	dpavlin	100	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	dpavlin	95	} else {
82	dpavlin	100	warn "## no uid for $v, first seen?\n" if $self->debug;
83			return;
84	dpavlin	95	}
85	dpavlin	81	} else {
86	dpavlin	100	$uid = $v;
87	dpavlin	81	}
88	dpavlin	100
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	dpavlin	79	}
97	dpavlin	85
98			=head2 state
99
100	dpavlin	100	my $state = $store->state( ID => $ID );
101			my $state = $store->state( uid => $uid );
102	dpavlin	85
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	dpavlin	100	my ( $k, $v ) = @_;
110			confess "need ID or uid" unless $k =~ m/^(ID\|uid)$/;
111			confess "need $k value" unless $v;
112
113	dpavlin	102	warn "## state( $k => $v )\n" if $self->debug;
114	dpavlin	100
115			my $uid;
116
117			if ( $k eq 'ID' ) {
118			if ( $uid = $self->ID_to_uid( $v ) ) {
119			# nop
120	dpavlin	95	} else {
121	dpavlin	100	warn "## no uid for $v so no state!\n" if $self->debug;
122	dpavlin	95	return;
123			}
124			} else {
125	dpavlin	100	$uid = $v;
126			}
127
128			if ( my $state = $self->db->get('state')->get( $uid ) ) {
129			return $state->export;
130			} else {
131	dpavlin	95	return;
132			}
133	dpavlin	100
134	dpavlin	85	}
135
136	dpavlin	95	=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	dpavlin	149	my $session;
159
160	dpavlin	95	sub ID_to_uid {
161			my $self = shift;
162			my ( $ID, $state ) = @_;
163
164			confess "need ID" unless $ID;
165
166	dpavlin	100	warn "ID_to_uid",dump( $ID, $state ),$/ if $self->debug;
167	dpavlin	95
168	dpavlin	149	$session->{ $ID }->{last_seen} = time();
169	dpavlin	95
170			my $uid;
171
172	dpavlin	149	if ( $uid = $session->{ $ID }->{ ID_to_uid } ) {
173	dpavlin	95	return $uid;
174			} elsif ( $uid = $state->{DeviceID}->{SerialNumber} ) {
175			warn "## created new session for $uid session $ID\n" if $self->debug;
176	dpavlin	149	$session->{ $ID } = {
177	dpavlin	95	last_seen => time(),
178			ID_to_uid => $uid,
179			};
180			return $uid;
181			} else {
182			warn "## can't find uid for ID $ID, first seen?\n";
183			return;
184			}
185
186			# TODO: expire sessions longer than 30m
187
188	dpavlin	149	warn "current session = ",dump( $session );
189
190	dpavlin	95	return;
191			}
192
193	dpavlin	77	1;