lib/CWMP/Store/HASH.pm

   1 package CWMP::Store::HASH;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter 'import';
   7 our @EXPORT = qw/
   8         $debug
   9 /;
  10
  11 use Data::Dump qw/dump/;
  12 use Hash::Merge qw/merge/;
  13 use Carp qw/confess/;
  14
  15 =head1 NAME
  16
  17 CWMP::Store::HASH - base class for hash based storage engines
  18
  19 =head1 METHODS
  20
  21 =head2 open
  22
  23   $store->open({
  24         path => 'var/',
  25         debug => 1,
  26         clean => 1,
  27   });
  28
  29 =cut
  30
  31 my $path;
  32
  33 my $debug = 0;
  34
  35 my $cleaned = 0;
  36
  37 sub open {
  38         my $self = shift;
  39
  40         my $args = shift;
  41
  42         $debug = $args->{debug};
  43         $path = $args->{path} || confess "no path?";
  44
  45         warn "open ",dump( $args ) if $debug;
  46
  47         $path = $self->full_path( $path );
  48
  49         if ( ! -e $path ) {
  50                 mkdir $path || die "can't create $path: $!";
  51                 warn "created $path directory\n" if $debug;
  52         } elsif ( $args->{clean} && ! $cleaned ) {
  53                 warn "removed old $path\n" if $debug;
  54                 foreach my $uid ( $self->all_uids ) {
  55                         my $file = $self->file( $uid );
  56                         unlink $file || die "can't remove $file: $!";
  57                 }
  58                 $cleaned++;
  59         }
  60
  61
  62 }
  63
  64 =head2 update_uid_state
  65
  66   my $new_state = $store->update_uid_state( $uid, $state );
  67
  68 =cut
  69
  70 sub update_uid_state {
  71         my ( $self, $uid, $state ) = @_;
  72
  73         my $file = $self->file( $uid );
  74
  75         my $old_state = $self->get_state( $uid );
  76
  77         my $combined = merge( $state, $old_state );
  78
  79 #       warn "## ",dump( $old_state, $state, $combined );
  80
  81         $self->save_hash( $file, $combined ) || die "can't write $file: $!";
  82
  83         return $combined;
  84 }
  85
  86 =head2 get_state
  87
  88   $store->get_state( $uid );
  89
  90 =cut
  91
  92 sub get_state {
  93         my ( $self, $uid ) = @_;
  94
  95         my $file = $self->file( $uid );
  96
  97         if ( -e $file ) {
  98                 return $self->load_hash( $file );
  99         }
 100
 101         return;
 102 }
 103
 104
 105 =head2 set_state
 106
 107   $store->set_state( $uid, $state );
 108
 109 =cut
 110
 111 sub set_state {
 112         my ( $self, $uid, $state ) = @_;
 113         my $file = $self->file( $uid );
 114         return $self->save_hash( $file, $state );
 115 }
 116
 117
 118 =head2 all_uids
 119
 120   my @uids = $store->all_uids;
 121
 122 =cut
 123
 124 sub all_uids {
 125         my $self = shift;
 126
 127         my $ext = $self->extension;
 128         #warn "## extension: $ext";
 129
 130         opendir(my $d, $path) || die "can't opendir $path: $!";
 131         my @uids = grep { $_ =~ m/\Q$ext\E$/ && -f "$path/$_" } readdir($d);
 132         closedir $d;
 133
 134         return map { my $l = $_; $l =~ s/\Q$ext\E$//; $l } @uids;
 135 }
 136
 137 1;