File Coverage

blib/lib/Data/Tabular/Dumper/XML.pm

Criterion	Covered	Total	%
statement	56	56	100.0
branch	10	10	100.0
condition	10	13	76.9
subroutine	9	9	100.0
pod	0	6	0.0
total	85	94	90.4

# $Id: XML.pm 456 2009-04-15 12:20:59Z fil $
package Data::Tabular::Dumper::XML;
use strict;

use Data::Tabular::Dumper::Writer;

use vars qw( @ISA );
@ISA = qw( Data::Tabular::Dumper::Writer );

###########################################################
sub open
{
    my($package, $param)=@_;

    my($file, $top, $record)=@$param;
    my $self = $package->SUPER::open( $file );

    $top||='DATA';
    $record||='RECORD';

    my $fh = $self->{fh};
    print $fh qq(\n<$top>\n);

    $self->{top} = $top;
    $self->{record} = $record;
    $self->{prefix} = '';

    return $self;
}

###########################################################
sub close
{
    my($self)=@_;
    my $fh = delete $self->{fh};
    return unless $fh;
    print $fh qq({top}>\n) ;
}

###########################################################
sub fields
{
    my($self, $fields)=@_;
    $self->{fields}=[@$fields];
}

###########################################################
sub write
{
    my($self, $data)=@_;

    my $fh=$self->{fh};

    my $record = $self->{record};
    my $q = 0;
    if( 1 < @{$self->{fields}} and $self->{fields}[0] eq ''
                               and $data->[0] ne '' ) {
        $record = $data->[0];
        $q++;
    }

    print $fh qq($self->{prefix}  <$record>\n);
    for( ; $q <=$#$data ; $q++ ) {
        my $f = $self->{fields}[$q > $#{$self->{fields}} ? -1 : $q];
        $f = $q if not defined $f or $f eq '';
        my $d=$data->[$q];
        next unless defined $d;
        $d=~s/&/&/g;
        $d=~s/
        $d=~s/>/>/g;
        print $fh qq($self->{prefix}    <$f>$d\n);
    }
    print $fh qq($self->{prefix}  \n);
}

###########################################################
sub page_start
{
    my( $self, $name ) = @_;
    $self->{prefix} .= '  ';

    $name =~ s/\W/_/g;
    my $fh=$self->{fh};
    print $fh "$self->{prefix}<$name>\n";
}

###########################################################
sub page_end
{
    my( $self, $name ) = @_;
    $name =~ s/\W/_/g;
    my $fh=$self->{fh};
    print $fh "$self->{prefix}\n";

    substr( $self->{prefix} , -2 ) = '';
}


1;

__END__