File Coverage

blib/lib/Metabrik/File/Xml.pm
Criterion Covered Total %
statement 9 34 26.4
branch 0 24 0.0
condition 0 8 0.0
subroutine 3 7 42.8
pod 2 4 50.0
total 14 77 18.1


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # file::xml Brik
5             #
6             package Metabrik::File::Xml;
7 1     1   1116 use strict;
  1         2  
  1         46  
8 1     1   6 use warnings;
  1         2  
  1         36  
9              
10 1     1   5 use base qw(Metabrik::File::Read);
  1         3  
  1         477  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             input => [ qw(file) ],
20             output => [ qw(file) ],
21             overwrite => [ qw(0|1) ],
22             },
23             attributes_default => {
24             overwrite => 1,
25             },
26             commands => {
27             read => [ qw(input_file|OPTIONAL) ],
28             write => [ qw($xml_hash output_file|OPTIONAL) ],
29             },
30             require_modules => {
31             'Metabrik::File::Write' => [ ],
32             'Metabrik::String::Xml' => [ ],
33             },
34             };
35             }
36              
37             sub brik_use_properties {
38 0     0 1   my $self = shift;
39              
40             return {
41 0   0       attributes_default => {
42             encoding => defined($self->global) && $self->global->encoding || 'utf8',
43             },
44             };
45             }
46              
47             sub read {
48 0     0 0   my $self = shift;
49 0           my ($input) = @_;
50              
51 0   0       $input ||= $self->input;
52 0 0         $self->brik_help_run_undef_arg("read", $input) or return;
53              
54 0 0         $self->open($input) or return;
55 0 0         my $data = $self->SUPER::read or return;
56 0           $self->close;
57              
58 0 0         my $xml = Metabrik::String::Xml->new_from_brik_init($self) or return;
59 0 0         my $decode = $xml->decode($data) or return;
60              
61 0           return $decode;
62             }
63              
64             sub write {
65 0     0 0   my $self = shift;
66 0           my ($xml_hash, $output) = @_;
67              
68 0   0       $output ||= $self->output;
69 0 0         $self->brik_help_run_undef_arg('write', $xml_hash) or return;
70 0 0         $self->brik_help_run_undef_arg('write', $output) or return;
71              
72 0 0         my $xml = Metabrik::String::Xml->new_from_brik_init($self) or return;
73 0 0         my $data = $xml->encode($xml_hash) or return;
74              
75 0 0         my $fw = Metabrik::File::Write->new_from_brik_init($self) or return;
76 0 0         $fw->open($output) or return;
77 0 0         $fw->write($data) or return;
78 0           $fw->close;
79              
80 0           return $data;
81             }
82              
83             1;
84              
85             __END__