lib/CWMP/Store/YAML.pm

   1 # Dobrica Pavlinusic, <dpavlin@rot13.org> 10/26/07 21:37:12 CEST
   2 package CWMP::Store::YAML;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Data::Dump qw/dump/;
   8 use YAML::Syck;
   9 use Hash::Merge qw/merge/;
  10 use Carp qw/confess/;
  11
  12 =head1 NAME
  13
  14 CWMP::Store::YAML - use YAML as storage
  15
  16 =head1 METHODS
  17
  18 =head2 open
  19
  20   $store->open({
  21         path => 'var/',
  22         debug => 1,
  23         clean => 1,
  24   });
  25
  26 =cut
  27
  28 my $path;
  29
  30 my $debug = 0;
  31
  32 sub open {
  33         my $self = shift;
  34
  35         my $args = shift;
  36
  37         $debug = $args->{debug};
  38         $path = $args->{path} || confess "no path?";
  39
  40         warn "open ",dump( $args ) if $debug;
  41
  42         $path = "$path/yaml";
  43
  44         if ( ! -e $path ) {
  45                 mkdir $path || die "can't create $path: $!";
  46                 warn "created $path directory\n" if $debug;
  47         } elsif ( $args->{clean} ) {
  48                 warn "removed old $path\n" if $debug;
  49                 foreach my $uid ( $self->all_uids ) {
  50                         my $file = "$path/$uid.yml";
  51                         unlink $file || die "can't remove $file: $!";
  52                 }
  53         }
  54
  55
  56 }
  57
  58 =head2 update_uid_state
  59
  60   $store->update_uid_state( $uid, $state );
  61
  62 =cut
  63
  64 sub update_uid_state {
  65         my ( $self, $uid, $state ) = @_;
  66
  67         my $file = "$path/$uid.yml";
  68
  69         my $old_state = $self->get_state( $uid );
  70
  71         my $combined = merge( $state, $old_state );
  72
  73 #       warn "## ",dump( $old_state, $state, $combined );
  74
  75         DumpFile( $file, $combined ) || die "can't write $file: $!";
  76
  77 }
  78
  79 =head2 get_state
  80
  81   $store->get_state( $uid );
  82
  83 =cut
  84
  85 sub get_state {
  86         my ( $self, $uid ) = @_;
  87
  88         my $file = "$path/$uid.yml";
  89
  90         if ( -e $file ) {
  91                 return LoadFile( $file );
  92         }
  93
  94         return;
  95 }
  96
  97 =head2 all_uids
  98
  99   my @uids = $store->all_uids;
 100
 101 =cut
 102
 103 sub all_uids {
 104         my $self = shift;
 105
 106         opendir(my $d, $path) || die "can't opendir $path: $!";
 107         my @uids = grep { /\.yml$/ && -f "$path/$_" } readdir($d);
 108         closedir $d;
 109
 110         return map { my $l = $_; $l =~ s/\.yml$//; $l } @uids;
 111 }
 112
 113 1;