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 qw/LoadFile DumpFile/;
   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 =cut
  21
  22 my $path;
  23
  24 my $debug = 1;
  25
  26 sub open {
  27         my $self = shift;
  28
  29         my $args = shift;
  30
  31         $debug = $args->{debug};
  32         $path = $args->{path} || confess "no path?";
  33
  34         warn "open ",dump( $args ) if $debug;
  35
  36         $path = "$path/yaml";
  37
  38         if ( ! -e $path ) {
  39                 mkdir $path || die "can't create $path: $!";
  40                 warn "created $path directory\n";
  41         }
  42
  43 }
  44
  45 =head2 update_uid_state
  46
  47   $store->update_uid_state( $uid, $state );
  48
  49 =cut
  50
  51 sub update_uid_state {
  52         my ( $self, $uid, $state ) = @_;
  53
  54         my $file = "$path/$uid.yml";
  55
  56         my $old_state = $self->get_state( $uid );
  57
  58         my $combined = merge( $state, $old_state );
  59
  60 #       warn "## ",dump( $old_state, $state, $combined );
  61
  62         DumpFile( $file, $combined ) || die "can't write $file: $!";
  63
  64 }
  65
  66 =head2 get_state
  67
  68   $store->get_state( $uid );
  69
  70 =cut
  71
  72 sub get_state {
  73         my ( $self, $uid ) = @_;
  74
  75         my $file = "$path/$uid.yml";
  76
  77         if ( -e $file ) {
  78                 return LoadFile( $file );
  79         }
  80
  81         return;
  82 }
  83
  84 =head2 all_uids
  85
  86   my @uids = $store->all_uids;
  87
  88 =cut
  89
  90 sub all_uids {
  91         my $self = shift;
  92
  93         opendir(my $d, $path) || die "can't opendir $path: $!";
  94         my @uids = grep { /\.yml$/ && -f "$path/$_" } readdir($d);
  95         closedir $d;
  96
  97         return map { my $l = $_; $l =~ s/\.yml$//; $l } @uids;
  98 }
  99
 100 1;