CatalystX::Usul::File::Storage::XML::Simple - Read/write XML data storage model

   package CatalystX::Usul::File::Storage;

   use parent qw(CatalystX::Usul);

   __PACKAGE__->config( class => q(XML::Simple) );

   sub new {
      my ($self, $app, $attrs) = @_; $attrs ||= {};

      my $class = $attrs->{class} || $self->config->{class};

      if (q(+) eq substr $class, 0, 1) { $class = substr $class, 1 }
      else { $class = __PACKAGE__.q(::).$class }

      $self->ensure_class_loaded( $class );

      return $class->new( $app, $attrs );
   }

# @(#)$Id: Simple.pm 576 2009-06-09 23:23:46Z pjf $

package CatalystX::Usul::File::Storage::XML::Simple;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.3.%d', q$Rev: 576 $ =~ /\d+/gmx );
use parent qw(CatalystX::Usul::File::Storage::XML);

use XML::Simple;

# Private methods

sub _read_file {
   my ($self, $path) = @_;

   my $method = sub {
      my $data   = $self->_dtd_parse( $path->all );
      my $arrays = [ keys %{ $self->_arrays } ];
      my $xs     = XML::Simple->new( SuppressEmpty => 1 );
      return $xs->xml_in( $data, ForceArray => $arrays );
   };

   return $self->_read_file_with_locking( $path, $method );
}

sub _write_file {
   my ($self, $path, $data) = @_;

   unless (-f $path->pathname) {
      $self->throw( error => 'File [_1] not found',
                    args  => [ $path->pathname ] );
   }

   my $method = sub {
      my $wtr = shift;
      my $xs  = XML::Simple->new( NoAttr   => 1, SuppressEmpty => 1,
                                  RootName => q(config) );
      $wtr->println( @{ $self->_dtd }      ) if ($self->_dtd->[ 0 ]);
      $wtr->append(  $xs->xml_out( $data ) );
      return $data;
   };

   return $self->_write_file_with_locking( $path, $method );
}

1;

__END__

# Local Variables:
# mode: perl
# tab-width: 3
# End: