File Coverage

blib/lib/Metabrik/File/Dump.pm
Criterion Covered Total %
statement 9 58 15.5
branch 0 26 0.0
condition 0 6 0.0
subroutine 3 6 50.0
pod 1 3 33.3
total 13 99 13.1


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # file::dump Brik
5             #
6             package Metabrik::File::Dump;
7 1     1   808 use strict;
  1         3  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         26  
9              
10 1     1   5 use base qw(Metabrik::File::Write);
  1         2  
  1         573  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable read write) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             input => [ qw(file) ],
20             output => [ qw(file) ],
21             append => [ qw(0|1) ],
22             },
23             attributes_default => {
24             append => 1,
25             },
26             commands => {
27             read => [ qw(file) ],
28             write => [ qw($data|$data_ref|$data_list output|OPTIONAL) ],
29             },
30             require_modules => {
31             'Data::Dump' => [ ],
32             'Metabrik::File::Read' => [ ],
33             },
34             };
35             }
36              
37             sub read {
38 0     0 0   my $self = shift;
39 0           my ($input) = @_;
40              
41 0   0       $input ||= $self->input;
42 0 0         $self->brik_help_run_undef_arg('read', $input) or return;
43              
44 0 0         my $fr = Metabrik::File::Read->new_from_brik_init($self) or return;
45 0           $fr->input($input);
46 0           $fr->encoding($self->encoding);
47 0           $fr->as_array(1);
48 0           $fr->strip_crlf(1);
49              
50 0 0         $fr->open or return;
51 0 0         my $data = $fr->read or return;
52 0           $fr->close;
53              
54 0           my @vars = ();
55 0           my $buf = '';
56 0           for (@$data) {
57 0           $buf .= $_;
58              
59 0 0         if (/^$/) {
60 0           push @vars, $buf;
61 0           $buf = '';
62             }
63             }
64              
65             # Gather last remaining line, if any
66 0 0         if (length($buf)) {
67 0           push @vars, $buf;
68 0           $buf = '';
69             }
70              
71 0           my @res = ();
72 0           for (@vars) {
73 0           my $h = eval($_);
74 0 0         if ($@) {
75 0           chomp($@);
76 0           $self->log->warning("read: eval failed: $@");
77 0           next;
78             }
79 0           push @res, $h;
80             }
81              
82 0           return \@res;
83             }
84              
85             sub write {
86 0     0 0   my $self = shift;
87 0           my ($data, $output) = @_;
88              
89 0   0       $output ||= $self->output;
90 0 0         $self->brik_help_run_undef_arg('write', $data) or return;
91 0 0         $self->brik_help_run_undef_arg('write', $output) or return;
92              
93 0           $self->log->debug("write: data[$data]");
94              
95 0 0         $self->open($output) or return;
96              
97 0 0         if (ref($data) eq 'ARRAY') {
98 0           for (@$data) {
99 0           my $r = $self->SUPER::write(Data::Dump::dump($_)."\n\n");
100 0 0         if (! defined($r)) {
101 0           return $self->log->error("write: write failed");
102             }
103             }
104             }
105             else {
106 0           my $r = $self->SUPER::write(Data::Dump::dump($data)."\n\n");
107 0 0         if (! defined($r)) {
108 0           return $self->log->error("write: write failed");
109             }
110             }
111              
112 0           $self->close;
113              
114 0           return 1;
115             }
116              
117             1;
118              
119             __END__