# XMLParser.pm - Will parse an XML file and return the DBI result set.
# Created by James A. Pattie.  Copyright (c) 2001-2002, Xperience, Inc.

package DBIWrapper::XMLParser;

use strict;
use XML::LibXML;
use DBIWrapper::ResultSet;
use vars qw ($AUTOLOAD @ISA @EXPORT $VERSION);

require Exporter;
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();

$VERSION = "1.1";

# new (file, string)
# required: file - xml file to work with, or string - xml data
#           in a string to work with.
# one of file or string must be specified.  If both are specified,
# then the string will take precedence.
sub new
{
  my $that = shift;
  my $class = ref($that) || $that;
  my $self = bless {}, $class;
  my %args = ( "file" => "", string => "", @_ );
  my $errStr = "DBIWrapper::XMLParser->new()  - Error:";

  if (length $args{file} > 0)
  {
    if ($args{file} !~ /^(.*\.xml)$/)
    {
      die "$errStr file = '$args{file}' is not a valid file!\n";
    }
    if (! -e $args{file})
    {
      die "$errStr Can not find config file = '$args{file}'!  $!\n";
    }
  }
  elsif (length $args{string} == 0)
  {
    die "$errStr You must specify either 'file' or 'string'!\n";
  }

  $self->{resultFile} = (length $args{string} > 0 ? $args{string} : $args{file});
  $self->{resultSetVersion} = "1.2";
  eval { $self->{resultSetObj} = DBIWrapper::ResultSet->new(); };
  if ($@)
  {
    die "$errStr $@\n";
  }

  eval { $self->{xmlObj} = XML::LibXML->new(); };
  if ($@)
  {
    die "$errStr $@\n";
  }

  if (length $args{file} > 0 && length $args{string} == 0)
  {
    eval { $self->{xmlDoc} = $self->{xmlObj}->parse_file($self->{resultFile}); };
  }
  else
  {
    eval { $self->{xmlDoc} = $self->{xmlObj}->parse_string($self->{resultFile}); };
  }
  if ($@)
  {
    die "$errStr $@\n";
  }

  return $self;
}

sub AUTOLOAD
{
  my $self = shift;
  my $type = ref($self) || die "$self is not an object";
  my $name = $AUTOLOAD;
  $name =~ s/.*://;	# strip fully-qualified portion
  unless (exists $self->{$name})
  {
    die "Can't access `$name' field in object of class $type";
  }
  if (@_)
  {
    return $self->{$name} = shift;
  }
  else
  {
    return $self->{$name};
  }
}

sub parse
{
  my $self = shift;
  my $nodes = undef;
  my $errStr = "DBIWrapper::XMLParser->parse()  - Error:";

  # start by validating the version of the XML file.
  $self->validateVersion;

  # initiate the data structure.  Fill in any default values possible.
  $self->{resultSetObj}->{version} = $self->{resultSetVersion};
  $self->{resultSetObj}->{resultFile} = $self->{resultFile};

  # gather the <select> and <status> values
  $self->getSelect();
  $self->getStatus();

  # gather the <rows> values
  $self->getRows();

  return $self->{resultSetObj};
}

# hash getAttributes(node)
# requires: node - XPath Node
# returns:  hash of attributes for the specified node.
sub getAttributes
{
  my $self = shift;
  my %args = ( node => undef, @_ );
  my $node = $args{node};
  my %attributes = ();
  my $errStr = "DBIWrapper::XMLParser->getAttributes()  - Error:";

  if (!defined $node)
  {
    die "$errStr  You must specify the XPath Node to work with!\n";
  }
  if ($node->getType() != XML_ELEMENT_NODE)
  {
    die "$errStr  You did not specify an XPath Node: " . $node->getType() . "\n";
  }
  foreach my $attribute ($node->getAttributes)
  {
    my $name = $attribute->getName;
    $attributes{$name} = $attribute->getValue;
  }

  return %attributes;
}

# array getNodes(path, context)
# required: path - XPath to search for
# optional: context - the XPath object to base the search from.  Make sure your path is relative to it!
# returns:  array - array of nodes returned.  These are the XPath objects representing each node.
sub getNodes
{
  my $self = shift;
  my %args = ( path => "*", context => undef, @_ );
  my $path = $args{path};
  my $context = $args{context};
  my @nodes = ( );
  my $nodes = undef;
  my $errStr = "DBIWrapper::XMLParser->getNodes()  - Error:";

  if (length $path == 0)
  {
    die "$errStr  You must specify a path!\n";
  }

  if (! defined $context)
  {
    $nodes = $self->{xmlDoc}->findnodes($path);
  }
  else
  {
    $nodes = $context->findnodes($path);
  }
  if (!$nodes->isa('XML::LibXML::NodeList'))
  {
    die "$errStr  Query '$path' didn't return a nodelist: " . $nodes->getType() . "\n";
  }
  if ($nodes->size)
  {
    #print "Found " . $nodes->size . " nodes...\n";
    foreach my $node ($nodes->get_nodelist)
    {
      push @nodes, $node;
    }
  }

  return @nodes;
}

# string getVersion(void)
# returns the version value from the parent <resultset> tag.
sub getVersion
{
  my $self = shift;
  my $errStr = "DBIWrapper::XMLParser->getVersion()  - Error:";

  my @nodes = $self->getNodes(path => "/resultset");
  if (scalar @nodes == 0)
  {
    die "$errStr  Your XML file doesn't contain a <resultset> tag!\n";
  }
  if (scalar @nodes > 1)
  {
    die "$errStr  You have too many <resultset> tags!  You should only have one!\n";
  }
  my %attributes = $self->getAttributes(node => $nodes[0]);
  if (!exists $attributes{version})
  {
    die "$errStr  You do not have the version defined!\n";
  }

  return $attributes{version};
}

# This routine looks up the <resultset version=""> tag and validates that the
# version specified is the same as what we know how to work with.
sub validateVersion
{
  my $self = shift;
  my $errStr = "XMLParser->validateVersion()  - Error:";

  my $version = $self->getVersion;
  if ($version !~ /^($self->{resultSetVersion})$/)
  {
    die "$errStr  '$version' is not equal to Version '$self->{resultSetVersion}'!\n";
  }
}

# void getSelect(void)
# requires: nothing
# returns: nothing
sub getSelect
{
  my $self = shift;
  my %args = ( @_ );
  my $errStr = "DBIWrapper::XMLParser->getSelect()  - Error:";

  my @nodes = $self->getNodes(path => "/resultset/select");
  if (scalar @nodes == 0)
  {
    $self->{resultSetObj}->{select} = 0;
    $self->{resultSetObj}->{sql} = "";
    $self->{resultSetObj}->{plug} = "";
  }
  if (scalar @nodes > 1)
  {
    die "$errStr  You have too many <select> tags!  You should only have one!\n";
  }
  # gather all attributes of the <select> tag.
  my %attributes = $self->getAttributes(node => $nodes[0]);
  my %encountered = ();
  foreach my $attribute (keys %attributes)
  {
    if (exists $encountered{$attribute})
    {
      die "$errStr  You have already defined '$attribute' in the <select> tag!\n";
    }
    if ($attribute !~ /^(sql|plug)$/)
    {
      die "$errStr  '$attribute' is invalid in the <select> tag!\n";
    }
    $encountered{$attribute} = 1;
  }
  foreach my $required ("sql", "plug")
  {
    if (!exists $encountered{$required})
    {
      die "$errStr  '$required' is required in the <select> tag!\n";
    }
  }
  $self->{resultSetObj}->{select} = 1;
  $self->{resultSetObj}->{sql} = $attributes{sql};
  $self->{resultSetObj}->{plug} = $attributes{plug};
}

# void getStatus(void)
# requires: nothing
# returns: nothing
sub getStatus
{
  my $self = shift;
  my %args = ( @_ );
  my $errStr = "DBIWrapper::XMLParser->getStatus()  - Error:";

  my @nodes = $self->getNodes(path => "/resultset/status");
  if (scalar @nodes == 0)
  {
    die "$errStr  Your XML file doesn't contain a <status> tag!\n";
  }
  if (scalar @nodes > 1)
  {
    die "$errStr  You have too many <status> tags!  You should only have one!\n";
  }
  # gather all attributes of the <status> tag.
  my %attributes = $self->getAttributes(node => $nodes[0]);
  my %encountered = ();
  foreach my $attribute (keys %attributes)
  {
    if (exists $encountered{$attribute})
    {
      die "$errStr  You have already defined '$attribute' in the <status> tag!\n";
    }
    if ($attribute !~ /^(result|error)$/)
    {
      die "$errStr  '$attribute' is invalid in the <status> tag!\n";
    }
    if ($attribute eq "result" && ($attributes{$attribute} !~ /^(Ok|Error)$/))
    {
      die "$errStr  $attribute = '$attributes{$attribute}' is invalid in the <status> tag!\n";
    }
    $encountered{$attribute} = 1;
  }
  foreach my $required ("result")
  {
    if (!exists $encountered{$required})
    {
      die "$errStr  '$required' is required in the <status> tag!\n";
    }
  }
  $self->{resultSetObj}->{result} = $attributes{result};
  $self->{resultSetObj}->{error} = (exists $attributes{error} ? $attributes{error} : "");
}

# void getRows(void)
# requires: nothing
# returns: nothing
sub getRows
{
  my $self = shift;
  my %args = ( @_ );
  my $errStr = "DBIWrapper::XMLParser->getRows()  - Error:";

  my @nodes = $self->getNodes(path => "/resultset/rows");
  if (scalar @nodes == 0)
  {
    die "$errStr  Your XML file doesn't contain a <rows> tag!\n";
  }
  if (scalar @nodes > 1)
  {
    die "$errStr  You have too many <rows> tags!  You should only have one!\n";
  }
  # gather all attributes of the <rows> tag.
  my %attributes = $self->getAttributes(node => $nodes[0]);
  my %encountered = ();
  foreach my $attribute (keys %attributes)
  {
    if (exists $encountered{$attribute})
    {
      die "$errStr  You have already defined '$attribute' in the <rows> tag!\n";
    }
    if ($attribute !~ /^(numRows|columns)$/)
    {
      die "$errStr  '$attribute' is invalid in the <rows> tag!\n";
    }
    if ($attribute eq "columns" && ($attributes{$attribute} !~ /^(0|1)$/))
    {
      die "$errStr  $attribute = '$attributes{$attribute}' is invalid in the <rows> tag!\n";
    }
    if ($attribute eq "numRows" && $attributes{$attribute} !~ /^(\d+)$/)
    {
      die "$errStr  $attribute = '$attributes{$attribute}' is invalid in the <rows> tag!\n";
    }
    $encountered{$attribute} = 1;
  }
  foreach my $required ("numRows", "columns")
  {
    if (!exists $encountered{$required})
    {
      die "$errStr  '$required' is required in the <rows> tag!\n";
    }
  }
  $self->{resultSetObj}->{numRows} = $attributes{numRows};
  $self->{resultSetObj}->{columns} = $attributes{columns};

  # now gather the rows
  if ($attributes{numRows} > 0)
  {
    if (!$attributes{columns})
    {
      $self->getRowData(node => $nodes[0]);
    }
    else
    {
      $self->getRowColumns(node => $nodes[0]);
    }
  }
}

# void getRowData(node)
# requires: node
# returns: nothing
# called when columns = 0
sub getRowData
{
  my $self = shift;
  my %args = ( node => undef, @_ );
  my $node = $args{node};
  my @rows = ();
  my $errStr = "DBIWrapper::XMLParser->getRowData()  - Error:";

  if (!defined $node)
  {
    die "$errStr  You must define the rows node to work from!\n";
  }

  # gather all <row>'s
  my @nodes = $self->getNodes(path => "*", context => $node);
  if (scalar @nodes == 0)
  {
    die "$errStr  Your XML file doesn't contain any <row>'s but numRows = '$self->{resultSetObj}->{numRows}'!\n";
  }

  for (my $i=0; $i < scalar @nodes; $i++)
  {
    # gather all attributes of the <row> tag.
    my %attributes = $self->getAttributes(node => $nodes[$i]);
    my @columnNames = ();
    my %encountered = ();
    if (scalar(keys %attributes) == 0)
    {
      die "$errStr  row: $i has 0 attributes defined!\n";
    }
    foreach my $attribute (sort keys %attributes)
    {
      if (exists $encountered{$attribute})
      {
        die "$errStr  You have already defined '$attribute' in the <row> tag!\n";
      }
      $encountered{$attribute} = 1;
      push @columnNames, $attribute;
    }
    push @rows, \%attributes;

    $self->{resultSetObj}->{columnNames} = \@columnNames if ($i == 0);
    $self->{resultSetObj}->{columnNamesHash} = \%encountered if ($i == 0);
  }

  $self->{resultSetObj}->{rows} = \@rows;
}

# void getRowColumns(node)
# requires: node
# returns: nothing
# called when columns = 0
sub getRowColumns
{
  my $self = shift;
  my %args = ( node => undef, @_ );
  my $node = $args{node};
  my @rows = ();
  my $errStr = "DBIWrapper::XMLParser->getRowColumns()  - Error:";

  if (!defined $node)
  {
    die "$errStr  You must define the rows node to work from!\n";
  }

  # gather all <row>'s
  my @nodes = $self->getNodes(path => "*", context => $node);
  if (scalar @nodes == 0)
  {
    die "$errStr  Your XML file doesn't contain any <row>'s but numRows = '$self->{resultSetObj}->{numRows}'!\n";
  }

  for (my $i=0; $i < scalar @nodes; $i++)
  {
    # gather all <column>'s
    my @columnNames = ();
    my %columnNamesHash = ();
    my %rowValues = ();

    my @columns = $self->getNodes(path => "*", context => $nodes[$i]);
    if (scalar @columns == 0)
    {
      die "$errStr  No <column>'s defined for row $i!\n";
    }
    for (my $j=0; $j < scalar @columns; $j++)
    {
      my $column = $columns[$j];

      # gather all attributes of the <column> tag.
      my %attributes = $self->getAttributes(node => $column);
      my %encountered = ();
      if (scalar(keys %attributes) == 0)
      {
        die "$errStr  row: $i, column: $j has 0 attributes defined!\n";
      }
      foreach my $attribute (sort keys %attributes)
      {
        if (exists $encountered{$attribute})
        {
          die "$errStr  You have already defined '$attribute' in the <column> tag!  row: $i, column: $j\n";
        }
        if ($attribute !~ /^(name|value)$/)
        {
          die "$errStr  '$attribute' is invalid in the <column> tag!  row: $i, column: $j\n";
        }
        $encountered{$attribute} = 1;
      }
      # make sure we have all the required attributes for this column.
      foreach my $required ("name", "value")
      {
        if (not exists $encountered{$required})
        {
          die "$errStr  '$required' is required in the <column> tag!  row: $i, column: $j\n";
        }
      }
      push @columnNames, $attributes{name};
      $columnNamesHash{$attributes{name}} = 1;
      $rowValues{$attributes{name}} = $attributes{value};
    }
    push @rows, \%rowValues;

    @columnNames = sort @columnNames;
    $self->{resultSetObj}->{columnNames} = \@columnNames if ($i == 0);
    $self->{resultSetObj}->{columnNamesHash} = \%columnNamesHash if ($i == 0);
  }

  $self->{resultSetObj}->{rows} = \@rows;
}

1;
__END__

=head1 NAME

XMLParser - The XML Configuration Parser Module.

=head1 SYNOPSIS

  use DBIWrapper::XMLParser;
  my $obj = DBIWrapper::XMLParser->new(file => "config.xml");
  my $resultSetObj = $obj->parse; # this is a ResultSet object.

=head1 DESCRIPTION

XMLParser will parse XML files that have been generated by the
DBIWrapper readXML method.  See the DBIWrapper::ResultSet
man page for the structure of the returned data.

=head1 FUNCTIONS

  scalar new(file, string)
    Creates a new instance of the DBIWrapper::ResultSet
    object.  file points to the XML Config file to use.

    If you don't specify a file to work with then you must specify the
    xml via the string argument.  If you specify both, then the string
    will take precedence.  The file must still point to a valid file.

  DBIWrapper::ResultSet parse(void)
    Does the actual parsing of the XML file and generates the
    resulting data object and returns it.

  string getVersion(void)
    returns the version value from the parent <resultset> tag.

=head1 VARIABLES

  resultFile - The xml file name we are working with or the contents
               of the string of xml passed in.

  resultSetVersion - The version of the XML file we require.

  resultSetObj - ResultSet object that represents the xml file.

  xmlObj - The XML::LibXML object being used to parse the XML File.

  NOTE:  All data fields are accessible by specifying the object
         and pointing to the data member to be modified on the
         left-hand side of the assignment.
         Ex.  $obj->variable($newValue); or $value = $obj->variable;

=head1 AUTHOR

Xperience, Inc. (mailto:admin at pcxperience.com)

=head1 SEE ALSO

perl(1), DBIWrapper::ResultSet(3)

=cut