WebPAC/Input/XML.pm

package WebPAC::Input::XML;

use warnings;
use strict;

use WebPAC::Input;
use base qw/WebPAC::Common/;

use XML::Simple;
use File::Find;

use Data::Dump qw/dump/;

=head1 NAME

WebPAC::Input::XML - support for reading XML files

=cut

our $VERSION = '0.01';

=head1 FUNCTIONS

=head2 new

Returns new low-level input API object

  my $input = new WebPAC::Input::XML(
        path => '/path/to/XML/records.txt'
        filter => sub {
                my ($l,$field_nr) = @_;
                # do something with $l which is line of input file
                return $l;
        },
  }

Options:

=over 4

=item path

path to directory with xml files ending in C<.xml>

=back

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        my $arg = {@_};

        my $log = $self->_get_logger();

        $log->logdie("can't find path ", $arg->{path}, ": $!\n") unless -d $arg->{path};

        $log->info("collecting xml files from ", $arg->{path});

        my @files;

        find({
                wanted => sub {
                        my $path = $File::Find::name;
                        return unless -f $path && $path =~ m/\.xml$/i;
                        push @files, $path;
                },
                follow => 1,
        }, $arg->{path} );

        $log->info("found ", $#files + 1, " XML files in ", $arg->{path});

        $self->{_files} = \@files;

        $self ? return $self : return undef;
}

=head2 fetch_rec

Return record with ID C<$mfn> from database

  my $rec = $input->fetch_rec( $mfn, $filter_coderef );

=cut

sub fetch_rec {
        my $self = shift;

        my ( $mfn, $filter_coderef ) = @_;

        my $path = $self->{_files}->[ $mfn - 1 ] || return;

        my $log = $self->_get_logger();

        my $xml = XMLin(
                $path,
#               ForceArray => 1,
#               ForceContent => 1,
#               KeepRoot => 1,
#               SuppressEmpty => 1, # '' undef

        ) || $log->logdie("can't open $path: $!");

        warn "### fetch_rec( $mfn ) => $path => xml is ",dump($xml);

        # add mfn
        $xml->{'000'} = [ $mfn ];

        return $xml;
}


=head2 size

Return number of records in database

  my $size = $input->size;

=cut

sub size {
        my $self = shift;
        return $#{$self->{_files}} + 1;
}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;
1	dpavlin	968	package WebPAC::Input::XML;
2
3			use warnings;
4			use strict;
5
6			use WebPAC::Input;
7			use base qw/WebPAC::Common/;
8
9			use XML::Simple;
10			use File::Find;
11
12			use Data::Dump qw/dump/;
13
14			=head1 NAME
15
16			WebPAC::Input::XML - support for reading XML files
17
18			=cut
19
20			our $VERSION = '0.01';
21
22			=head1 FUNCTIONS
23
24			=head2 new
25
26			Returns new low-level input API object
27
28			my $input = new WebPAC::Input::XML(
29			path => '/path/to/XML/records.txt'
30			filter => sub {
31			my ($l,$field_nr) = @_;
32			# do something with $l which is line of input file
33			return $l;
34			},
35			}
36
37			Options:
38
39			=over 4
40
41			=item path
42
43			path to directory with xml files ending in C<.xml>
44
45			=back
46
47			=cut
48
49			sub new {
50			my $class = shift;
51			my $self = {@_};
52			bless($self, $class);
53
54			my $arg = {@_};
55
56			my $log = $self->_get_logger();
57
58			$log->logdie("can't find path ", $arg->{path}, ": $!\n") unless -d $arg->{path};
59
60			$log->info("collecting xml files from ", $arg->{path});
61
62			my @files;
63
64			find({
65			wanted => sub {
66			my $path = $File::Find::name;
67			return unless -f $path && $path =~ m/\.xml$/i;
68			push @files, $path;
69			},
70			follow => 1,
71			}, $arg->{path} );
72
73			$log->info("found ", $#files + 1, " XML files in ", $arg->{path});
74
75			$self->{_files} = \@files;
76
77			$self ? return $self : return undef;
78			}
79
80			=head2 fetch_rec
81
82			Return record with ID C<$mfn> from database
83
84			my $rec = $input->fetch_rec( $mfn, $filter_coderef );
85
86			=cut
87
88			sub fetch_rec {
89			my $self = shift;
90
91			my ( $mfn, $filter_coderef ) = @_;
92
93			my $path = $self->{_files}->[ $mfn - 1 ] \|\| return;
94
95	dpavlin	970	my $log = $self->_get_logger();
96	dpavlin	968
97	dpavlin	981	my $xml = XMLin(
98			$path,
99			# ForceArray => 1,
100			# ForceContent => 1,
101			# KeepRoot => 1,
102			# SuppressEmpty => 1, # '' undef
103	dpavlin	970
104	dpavlin	981	) \|\| $log->logdie("can't open $path: $!");
105
106	dpavlin	970	warn "### fetch_rec( $mfn ) => $path => xml is ",dump($xml);
107
108			# add mfn
109			$xml->{'000'} = [ $mfn ];
110
111			return $xml;
112	dpavlin	968	}
113
114
115			=head2 size
116
117			Return number of records in database
118
119			my $size = $input->size;
120
121			=cut
122
123			sub size {
124			my $self = shift;
125			return $#{$self->{_files}} + 1;
126			}
127
128			=head1 AUTHOR
129
130			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
131
132			=head1 COPYRIGHT & LICENSE
133
134			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
135
136			This program is free software; you can redistribute it and/or modify it
137			under the same terms as Perl itself.
138
139			=cut
140
141			1;