#!/usr/bin/env perl
# vim:ts=8 sw=4 sts=4 ai
require v5.6.1;
use strict;
use warnings;

=head1 NAME

xml2fv - convert an XML file into Tie::FieldVals data.

=head1 VERSION

This describes version B<0.6203> of xml2fv.

=cut

our $VERSION = '0.6203';

=head1 SYNOPSIS

xml2fv --help | --manpage | --version

xml2fv I<xmlfile> [ I<outfile> ]

=head1 DESCRIPTION

This script converts an XML file into Tie::FieldVals data.

=head1 OPTIONS

=over

=item --help

Print help message and exit.

=item --manpage

Print the full help documentation (manual page) and exit.

=item --verbose

Print informational messages.

=item --version

Print version information and exit.

=back

=head1 FILE FORMATS

=head2 XML FORMAT

The format of the input XML file is as follows:

    <fv_data>
        <record>
	   <Field>Value</Field>
	    <AnotherField>AnotherValue</AnotherField>
	    ...
	</record>
	...
    </fv_data>

Each field name is given its own tag, and the element contains
the value for that field.

=head2 FieldVals Format

The output data file is in the form of Field:Value pairs, with each
record separated by a line with '=' on it.

See L<Tie::FieldVals/FILE FORMAT> for more information.

=head1 REQUIRES

    Getopt::Long
    Pod::Usage
    Getopt::ArgvFile
    Data::Dumper
    Tie::FieldVals::Row

=head1 SEE ALSO

perl(1)
Getopt::Long
Getopt::ArgvFile
Pod::Usage

=cut

use Getopt::Long 2.34;
use Getopt::ArgvFile qw(argvFile);
use Pod::Usage;
use Data::Dumper;
use Tie::FieldVals::Row;

#========================================================
# Subroutines
sub init_data ($) {
    my $data_ref = shift;

    # options
    my %default_conf = ();
    $default_conf{debug} = 0;
    $default_conf{manpage} = 0;
    $default_conf{version} = 0;
    $default_conf{verbose} = 0;
    $default_conf{outfile} = '-';
    $default_conf{xmlfile} = '';
    $data_ref->{options} = \%default_conf;
} # init_data

sub process_args ($) {
    my $data_ref = shift;

    my $ok = 1;

    argvFile(home=>1,current=>1,startupFilename=>'.xml2fvrc');

    pod2usage(2) unless @ARGV;

    my $op = new Getopt::Long::Parser;
    $op->configure(qw(auto_version auto_help));
    $op->getoptions($data_ref->{options},
		    'verbose!',
		    'manpage',
		    'debug!',
		    'xmlfile=s',
		    'outfile=s',
		   ) or pod2usage(2);

    if ($data_ref->{options}->{'manpage'})
    {
	pod2usage({ -message => "$0 version $VERSION",
		    -exitval => 0,
		    -verbose => 2,
	    });
    }

} # process_args

sub convert_file ($) {
    my $data_ref = shift;

    my $outfile = $data_ref->{options}->{outfile};

    print STDERR "xmlfile: ", $data_ref->{options}->{xmlfile},
	" outfile: ", $outfile,
	"\n" if ($data_ref->{options}->{verbose});
    if ($data_ref->{options}->{debug})
    {
	print STDERR Data::Dumper->Dump([$data_ref], [qw(xml2fv)]);
    }

    my $outhandle = \*STDOUT;
    if ($outfile ne '-')
    {
	open(OUTFILE, ">$outfile") || die "Can't open '$outfile' for writing.";
	$outhandle = \*OUTFILE;
    }
    # open the XML file and go through it, with </record>
    # as the record separator
    my $recsep = '</record>';
    my $count = 0;
    my @field_names = ();
    {
	local $/ = $recsep;
	open(FILE, $data_ref->{options}->{xmlfile})
	    or die "cannot open ", $data_ref->{options}->{xmlfile};
	while (my $rec = <FILE>)
	{
	    warn $rec, "\n" if $data_ref->{options}->{debug};
	    if ($rec =~ /<record>/)
	    {
		my %row = ();
		my $row_obj;
		if (@field_names)
		{
		    $row_obj = tie %row, 'Tie::FieldVals::Row',
			fields=>\@field_names;
		    $row_obj->set_from_xml_string($rec);
		}
		else # get the field names from the first record
		{
		    $row_obj = tie %row, 'Tie::FieldVals::Row',
			fields=>[qw(dummy)];
		    $row_obj->set_from_xml_string($rec,
			override_keys=>1);
		    @field_names = @{$row_obj->field_names()};
		    # print the initial empty record
		    foreach my $fn (@field_names)
		    {
			print $outhandle "$fn:\n";
		    }
		    print $outhandle "=\n";
		}
		# print the current record
		print $outhandle $row_obj->get_as_string();
		print $outhandle "\n=\n";
		$count++;
	    }
	}
	close(FILE);
    }

    print STDERR "$count records processed\n" if ($data_ref->{options}->{verbose});

    if ($outfile ne '-')
    {
	close(OUTFILE);
    }
    print STDERR "done!\n" if ($data_ref->{options}->{verbose});
} # convert_file

#========================================================
# Main

MAIN: {
    my %data = ();

    init_data(\%data);
    process_args(\%data);

    # first argument is the xmlfile
    if (@ARGV)
    {
	$data{options}->{xmlfile} = shift @ARGV;
    }
    if (!$data{options}->{xmlfile})
    {
	print STDERR "$0 no xmlfile\n";
	return 1;
    }
    if (!-e $data{options}->{xmlfile})
    {
	print STDERR "$0 xmlfile not found\n";
	return 1;
    }

    # remaining argument is the output file
    if (@ARGV)
    {
	$data{options}->{outfile} = shift @ARGV;
    }
    convert_file(\%data);
}

=head1 BUGS

Please report any bugs or feature requests to the author.

=head1 AUTHOR

    Kathryn Andersen (RUBYKAT)
    perlkat AT katspace dot com
    http://www.katspace.com

=head1 COPYRIGHT AND LICENCE

Copyright (c) 2004 by Kathryn Andersen

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


=cut

__END__