use strict;
use warnings;
package XML::HoA;

use base 'Exporter';
our @EXPORT_OK=qw(genRecord);

=pod

=head1 SYNOPSIS

  # $aData    reference to an array storing zero or more
  #           hash references. Each hash reference represents
  #           a different record.  The key-value pairs of the
  #           hash store the value assigned to each field in
  #           the record.  The keys are the field names and
  #           the value for each key is the value assigned to
  #           that field
  #
  # $hOptions reference to a hash storing formatting options
  #           for each record.
  #
  #           key        meaning
  #           ----       -------
  #           format     6 possible values - see below
  #                      defaults to NAME_EQ_VAL
  #           record     tag name for XML element storing
  #                      each record - defaults to 'record'
  #           field      tag name for the XML element storing
  #                      each field - defaults to 'field'
  #           name       tag name for the XML element storing
  #                      the field name - defaults to 'name'
  #           value      tag name for the XML element storing
  #                      the value assigned to a field
  #                      - defaults to 'value'
  #           filter     reference to a subroutine that filters
  #                      hash keys and determines which get
  #                      included in the record
  #
  # $iDepth   number of tabs to indent the first record
  #           the "tab" is defined via $XML::HoA::TAB and
  #           is initially set to "   "; $iDepth defaults to 0

  my $sXML;
  $sXML = genRecord($aData);
  $sXML = genRecord($aData, $hOptions, $iDepth);

  # Example

  my $aData
     = [ { lname => 'Krynicky', fname => 'Jenda' }
       , { 'Site' => 'PerlMonks', 'Nick' => 'Jenda' }
       ];
  my $hOptions = { format => XML::HoA::NAME_TEXT_VAL_TEXT
                   , record => 'page'
                   , name => 'id' };

  print genRecord($aData, $hOptions);


=head1 DESCRIPTION

Module for converting arrays of hashes to XML.  This module
supports custom names for tags and six different ways of
representing the fields of a record.

You can choose which of the six you want by setting the C<format>
key of options hash (2nd parameter of C<genRecord(...)>. Other
keys of the options hash will be interpreted based on your selected
format.

=head2 Configuring formats

The six format values are:

=head3 XML::HoA::NAME_EQ_VAL

This format converts field values to C<fieldName="value">, like
this:

  <record
     lname="Krynicky"
     fname="Jenda"
  />

You can change the name of the record element using the option
hash key C<record>.  For example, if your option hash was

 { format => XML::HoA::NAME_EQ_VAL, record => 'page' }

Then your output would be:

  <page
     lname="Krynicky"
     fname="Jenda"
  />


=head3 XML::HoA::NAME_TAG_VAL_ATTR

This format converts each field to an element whose tag is the
the same as the field name. The value is an attribute:

  <record>
     <lname value="Krynicky"/>
     <fname value="Jenda"/>
  </record>

As with C<NAME_EQ_VAL>, you can set the C<record> element of the
option hash to change the record tag.  You can also use the
C<value> element to change the attribute name.  For example if
your option hash was:


 { format => XML::HoA::NAME_EQ_VAL
   , record => 'page'
   , value=>'input'
 }

Then your output would be:

  <page>
     <lname input="Krynicky"/>
     <fname input="Jenda"/>
  </page>

=head3 XML::HoA::NAME_TAG_VAL_TEXT

This format converts each field to an element whose tag is the
the same as the field name. The value is element text:

  <record>
     <lname>Krynicky</lname>
     <fname>Jenda</fname>
  </record>

As with C<XML::HoA::NAME_EQ_VAL>, only the C<format> and C<record>
keys of the option hash will be used.


=head3 XML::HoA::NAME_ATTR_VAL_ATTR

This format has one element for each field. The value is
stored as an attribute of each of these elements:

  <record>
     <field name="lname" value="Krynicky"/>
     <field name="fname" value="Jenda"/>
  </record>

All of the hash keys may be used to change the name of tags.
The following value of the options hash:

  { format => XML::HoA::NAME_TEXT_VAL_TEXT
    , record => 'person'
    , field  => 'property'
    , name   => 'ID'       #attribute name
    , value  => 'VALUE'    #attribute name
  }

would produce the following XML:

  <person>
     <property ID="lname" VALUE="Krynicky"/>
     <property ID="fname" VALUE="Jenda"/>
  </persn>

=head3 XML::HoA::NAME_ATTR_VAL_TEXT

This format has one element for each field. The value is
stored as the text of each of these elements:

  <record>
     <field name="lname">Krynicky</field>
     <field name="fname">Jenda</field>
  </record>

This format uses the same option hash keys as
C<XML::HoA::NAME_ATTR_VAL_ATTR>. TheC<value> key is ignored
since there is no value attribute.

=head3 XML::HoA::NAME_TEXT_VAL_TEXT

This format assigns the field name and field value to separate
elements:

  <record>
     <field>
       <name>lname</name>
       <value>Krynicky</value>
     </field>
     <field>
       <name>fname</name>
       <value>Jenda</value>
     </field>
  </record>

All of the hash keys may be used to change the name of tags.
The following value of the options hash:

  { format => XML::HoA::NAME_TEXT_VAL_TEXT
    , record => 'person'
    , field  => 'property'
    , name   => 'ID'
    , value  => 'VALUE'
  }

Would result in the following XML:

  <person>
     <property>
       <ID>lname</ID>
       <VALUE>Krynicky</VALUE>
     </property>
     <property>
       <ID>fname</ID>
       <VALUE>Jenda</VALUE>
     </property>
  </person>


=head2 Filtering record data

Sometimes you don't want to print all of the keys in a hash. If
you need to filter out some of the keys you can write a
routine. This routine takes three arguments, in order:

* the current hash key

* the value assigned to the current hash key

* a reference to the hash storing the record data

It returns 1 if the key should be included and 0 otherwise.
The default filter is a no-op: it always returns 1 so that
all keys are selected.

The following example only includes fields whose names are all
lowercase in the XML record:

   my $crFilter = sub {
      my ($k,$v,$hRecord) = @_;
      return $k =~ /^[a-z]+$/;
   }

   print genRecord($aData, { filter => $crFilter });


=head1 CAVEATS

Tested only via inspection.

=head1 AUTHOR

Elizabeth Grace Frank-Backman

=head1 COPYRIGHT

Copyright (c) 2008- Elizabeth Grace Frank-Backman. All rights
reserved.

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

=cut

#==================================================================
# SHARED DATA AND CONSTANTS
#==================================================================

our $TAB="  ";
use constant {
  NAME_EQ_VAL => 1
  , NAME_TAG_VAL_ATTR => 2
  , NAME_TAG_VAL_TEXT => 3
  , NAME_ATTR_VAL_ATTR => 4
  , NAME_ATTR_VAL_TEXT => 5
  , NAME_TEXT_VAL_TEXT => 6
};
my $DEFAULT_FORMAT=NAME_EQ_VAL;

#==================================================================
# FUNCTIONS
#==================================================================

sub genEndTag {
  my ($sIndent, $sTag, $bAttributes) = @_;
  return $bAttributes ? "/>\n": "$sIndent</$sTag>\n";
}

#-----------------------------------------------------------

sub genField {
  my ($k, $v, $hOptions, $iDepth) = @_;
  $hOptions = {} unless defined($hOptions);
  $iDepth=0 unless defined($iDepth);

  #set up options
  my $iFmt = $hOptions->{format};
  $iFmt=$DEFAULT_FORMAT unless defined($iFmt);

  my $sFieldTag = $hOptions->{field};
  $sFieldTag='field' unless defined($sFieldTag);

  my $sNameTag = $hOptions->{name};
  $sNameTag='name' unless defined($sNameTag);

  my $sValueTag = $hOptions->{value};
  $sValueTag='value' unless defined($sValueTag);

  #generate field XML
  my $sXML='';
  my $sIndent=$TAB x $iDepth;
  if ($iFmt eq NAME_EQ_VAL) {
    $sXML .= "$sIndent$k=\"$v\"\n";
  } elsif ($iFmt eq NAME_TAG_VAL_ATTR) {
    $sXML .= "$sIndent<$k $sValueTag=\"$v\"/>\n";
  } elsif ($iFmt eq NAME_TAG_VAL_TEXT) {
    $sXML .= "$sIndent<$k>$v</$k>\n";
  } elsif ($iFmt eq NAME_ATTR_VAL_ATTR) {
    $sXML .= "$sIndent<$sFieldTag $sNameTag=\"$k\" "
      ."$sValueTag=\"$v\"/>\n";
  } elsif ($iFmt eq NAME_ATTR_VAL_TEXT) {
    $sXML .= "$sIndent<$sFieldTag $sNameTag=\"$k\">"
      ."$v</$sFieldTag>\n";
  } elsif ($iFmt eq NAME_TEXT_VAL_TEXT) {
    my $sIndentTag= $TAB x ($iDepth + 1);
    $sXML .= "$sIndent<$sFieldTag>\n";
    $sXML .= "$sIndentTag<$sNameTag>$k</$sNameTag>\n";
    $sXML .= "$sIndentTag<$sValueTag>$v</$sValueTag>\n";
    $sXML .= "$sIndent</$sFieldTag>\n";
  }
  return $sXML;
}

#------------------------------------------------------------

sub genRecord {
  my ($aData, $hOptions, $iDepth) = @_;
  $iDepth=0 unless defined($iDepth);
  $hOptions = {} unless defined($hOptions);

  #set up options
  my $iFmt = $hOptions->{format};
  $iFmt=$DEFAULT_FORMAT unless defined($iFmt);

  my $sRecordTag = $hOptions->{record};
  $sRecordTag='record' unless defined($sRecordTag);

  my $crFilter = $hOptions->{filter};

  my $sIndent=$TAB x $iDepth;
  my $sXML = '';
  my $bAttributes = ($iFmt eq NAME_EQ_VAL);
  foreach my $hRecord (@$aData) {
    $sXML .= genStartTag($sIndent, $sRecordTag, $bAttributes);
    while (my ($k, $v) = each(%$hRecord)) {
      if (defined($crFilter) && ! &$crFilter($k,$v,$hRecord)) {
        next;
      }
      $sXML .= genField($k, $v, $hOptions, $iDepth+1);
    }
    $sXML .= genEndTag($sIndent, $sRecordTag, $bAttributes);
  }
  return $sXML;
}

#------------------------------------------------------------
sub genStartTag {
  my ($sIndent, $sTag, $bAttributes) = @_;
  return "$sIndent<$sTag" . ($bAttributes ? "\n" : ">\n");
}

#==================================================================
# MODULE INITIALIZATION
#==================================================================

1;