#
# XMLUtils.pm
#   a module for useful database utilities
#
package Bio::Genex::XMLUtils;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
use Carp;
use DBI;
use CGI qw(:standard);

use Bio::Genex;
use XML::DOM;

require Exporter;

=head1 NAME

XMLUtils - a module for useful XML utilities for Genex DBs

=head1 SYNOPSIS

  use XMLUtils;

  $out_string = pretty_print($in_string);
  assert_element($dom_node, 'node_name');

=head1 DESCRIPTION

Methods for transforming information from a GeneX DB into XML.

=cut

@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT_OK = qw(pretty_print assert_element);

$DEBUG = 0;

$VERSION = '0.04';

=pod



=head1 FUNCTIONS


=over 4


=item pretty_print($string)

=item pretty_print({INDENT=>$val,COLLAPSE=>[@list1],NO_ATTR_BALANCE=>[@list2]},$string)

This function takes an XML string and reformats it. The function takes
an optional first parameter anonymous hash reference that enables
modification of the internal reformatting parameters.


=over 4


=item *

INDENT

The indent level in spaces. The defualt is 2.

=item *

COLLAPSE

A list of tags that should have their beginning and end tags collapsed
onto a single line. This will result in any intervening tags collapsed
onto the same line. The default is C<('feature')>.


=item *

NO_ATTR_BALANCE

A list of attribute names that should not be moved to a separate
line. The default is C<('xml')>.


=back


=cut


sub pretty_print {
  my $INDENT = 2;
  my %COLLAPSING      = ('feature'=>1);
  my %NO_ATTR_BALANCE = ('xml'=>1);

  # check if we're called with a parameter
  if (ref($_[0]) eq 'HASH') {
    # we were called with an anonymous hash as the first parameter
    # grab it and parse the parameter => value pairs
    my %hash = %{shift(@_)};
    $INDENT = $hash{INDENT} if exists $hash{INDENT}; 
    if (exists $hash{COLLAPSE}) {
      croak "Must use array ref for COLLAPSE" 
	unless ref($hash{COLLAPSE}) eq 'ARRAY';
      %COLLAPSING = map {$_, 1} @{[$hash{COLLAPSE}]};
    }
    if (exists $hash{NO_ATTR_BALANCE}) {
      croak "Must use array ref for NO_ATTR_BALANCE" 
	unless ref($hash{NO_ATTR_BALANCE}) eq 'ARRAY';
      %NO_ATTR_BALANCE = map {$_, 1} @{[$hash{NO_ATTR_BALANCE}]};
    }
  }

  # Now get the string
  my $xml_string = shift;
  $xml_string =~ s/\n//g;
  
  # break the tags apart by adding newlines
  $xml_string =~ s/>\s*</>\n</g;
  my @tags = split("\n",$xml_string);
  my $out_string;
  my $balance = 0;
  my ($padding,$tag_name);
  my $looking_for = '';
  foreach my $tag (@tags) {
    ($tag_name) = $tag =~ m|^<[/?!]?(\w+)|;
    unless (defined $tag_name) {
      unless ($tag =~ /^<!--/) {
	warn "no tag name for tag: $tag\n";      
      }
      $tag_name = '';
    }

    if ($looking_for) {
      if ($tag_name eq $looking_for) {
	$looking_for = '';
	$out_string .= "$tag\n";
      } else {
	$out_string .= $tag;
      }
    } elsif (exists $COLLAPSING{$tag_name}) {
      $looking_for = $tag_name;
      $out_string .= "$padding$tag";
    } else {
      $balance -= $INDENT if $tag =~ m|^</.*>$|;	# close tag
      $padding = ' ' x $balance;

      # don't modify balance on <?...> or <!...> or <.../> tags
      # the [^>]* insures we won't wrap or indent a tag pair with CDATA
      # e.g. <desc>description</desc> will stay on a single line
      $balance += $INDENT if $tag =~ m|^<[^/!?][^>]*[^/]>$|m; # open tag

      # move each attribute to it's own line unless instructed not to
      $tag =~ s|\"\s+([^\"])|"\"\n$padding        $1"|eg 
	unless exists $NO_ATTR_BALANCE{$tag_name};
      $out_string .= "$padding$tag\n";
    }
  }
  return $out_string;
}


=item assert_element($dom_node, $node_name);

This raises an exception unless $dom_node is an obect of type
XML::DOM::Node, and the tag name is $node_name.


=cut

sub assert_element {
  my ($node,$name) = @_;
  croak "Not a valid DOM Element node" unless 
    ref($node) eq 'XML::DOM::Element' &&
      $node->getTagName() eq $name;
}

# Autoload methods go after =cut, and are processed by the autosplit program.


1;
__END__

=pod



=back



=head1 AUTHOR

Jason Stewart (jes@ncgr.org)

=head1 SEE ALSO

perl(1).

=cut
