# @(#)86	1.4 src/43haes/lib/perl/DataWriter.pm, hacmp, 61haes_r714 3/21/06 16:42:30
# IBM_PROLOG_BEGIN_TAG 
# This is an automatically generated prolog. 
#  
# 61haes_r714 src/43haes/lib/perl/DataWriter.pm 1.4 
#  
# Licensed Materials - Property of IBM 
#  
# COPYRIGHT International Business Machines Corp. 2003,2006 
# All Rights Reserved 
#  
# US Government Users Restricted Rights - Use, duplication or 
# disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
#  
# IBM_PROLOG_END_TAG 
package DataWriter;

=head1 NAME

DataWriter - Perl extension for displaying complex data structures

=head1 SYNOPSIS

  use DataWriter;

  my $xmlWriter = DataWriter->new();
  $xmlWriter->addSortingRule( "CONFIG", [ "CLUSTER", "NODES", "NETWORKS" ] );
  $xmlWriter->writeToXML( $cluster, \*STDOUT );

=head1 DESCRIPTION

This package can be used to write out a complex Perl data structure in a
number of formats.  Currently, the supported formats are:
	XML

The format of the data structure can arbitrary:  a hash of hashes, a hash
of arrays; an array of hashes or anything with no limit of depth.  There
should be no circularity, otherwise the writers may go into an infinite
loop.

=head1 COPYRIGHT

(C) COPYRIGHT International Business Machines Corp. 2003
All Rights Reserved

=head1 METHODS

=cut

##
#
# Developers,
# The Programming Perl (Camel) book, 3rd Edition says the use of 
# prototypes on methods are not honored.  They are included for
# documentation purposes only, and can be easily removed with no
# loss of functionality or safety.
#
# Also, as the need exists, change the 'internal' document format
# to POD.
##

use 5.006;
use strict;
use warnings;
use Carp;

require Exporter;

our @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.

# This allows declaration	use DataWriter ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);
our $VERSION = '0.01';


# Preloaded methods go here.

=head2 new()

Description:

   new() is the constructor for the DataWriter.  This allows the developer
   to separate data from its presentation.  XML, as an output format, specifies
   that entities be written out in a particular order.  This DataWriter allows
   the developer to specify 'rules' as to how hash structures should be sorted
   when writing out the data.  

Arguments:

	This constructor supports named parameters; the following are
	supported:

		Indent_text: the text to use to indent the text;
           by default it is four spaces

        Show_nonexisting_tags: if 1, tags specified by a sorting rule 
           but having no data will be printed.

Returns:

    A new DataWriter object.

Example:

    my $xmlWriter = DataWriter::new();
    my $xmlWriter2 = DataWriter::new( Indent_Text => "\t" );

=cut

sub new($;@) {
    my $proto  = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
	my %args = @_;	

	$self->{_indentLevel} = 0; 		# the indentation level
	$self->{_sortRules} = {};	# used to store the rules
	$self->{_indentText} = $args{Indent_text} || "    ";
	$self->{_show_nonexisting_tags} = $args{Show_nonexisting_tags} || 0;
        $self->{_show_null_values} = $args{Show_null_values} || 0;

    return bless $self, $class;
}

=head2 writeToXML()

Description:

   writeToXML() is the method for writing the complex data structure as an 
   fragment of an XML document. Currently attributes are not supported.
   It is up to the calling program to write out the XML declaration,
   DOCTYPE declarations, and so forth.

Arguments:

   $: a reference to the compound data structure (hash of hases) 
   $: (optional) the filehandle where the XML document will be written.
      If not specified, standard out will be used.

Returns:

   1 if successful; 0 if there are errors (file I/O).  This routine will 
     use Carp to write out the errors.

Example:

   $xmlWriter->writeToXML( $cluster, \*XMLFILE );

=cut

sub writeToXML($;$) {
	my $self = shift;
	my $data = shift;
	my $fh = shift || *STDOUT;

	return $self->writeArrayToXML($data, $fh) if ( ref $data eq "ARRAY" );
	return $self->writeHashToXML($data, $fh)  if ( ref $data eq "HASH" );
	Carp::croak "Not a compound data structure $data";
	return 0;
}

=head2 addSortingRule()

Description:

  If part of the compound data structures are indeed hashes, the
  programmer can use addSortingRule() to specified the sort-order of the
  hash data structure.

  Hash structures without sort rules will generate XML with no particular
  order associated with it.  

Arguments:

   $: the entity with which a rule will be associated.
   \@: the list of indices for the hash structure that will be used for
       for sorting.  Indices not specified will not be listed.  Indices which 
       no data corresponding will be listed if the Show_nonexisting_tags
       parameter was specified when the DataWriter object was created
       (see new).

Returns:

   Nothing.

Example:

   no strict 'subs';
   $xmlWriter->addSortingRule( CLUSTER,
      [ "META:DEBUG", VERSION, VALIDATED, CLUSTER, NODES, NETWORKS, IPLABELS,
        INTERFACES, GLOBALNETWORKS, APPLICATIONS, APPLICATIONSERVERS,
        APPLICATIONMONITORS, SITES, CLUSTEREVENTS, NODETTYPORTS, PAGERS, DISKS,
        VOLUMEGROUPS, LOGICALVOLUMES, NFSEXPORTS, TAPES, TIMERS, RESOURCEGROUPS,
        PROCESSINGORDER, SETTLINGTIME ] );
   use strict 'subs';

=cut

sub addSortingRule($\@) {
	my $self = shift;
	my $tagname = shift;
	my $indices = shift;
	$self->{_sortRules}{$tagname} = $indices;
}

# The following are not documented with POD since we do not want them in the
# resulting documentation.

# Name: pad
#
# Description:
#    Internal method for returning the proper amount of indentation.
#
# Arguments:
#    None.
#
# Returns:
#    a string containing the spacing for indentation.
#
sub pad()
{
	my $self = shift;
	return $self->{_indentText} x $self->{_indentLevel};
}

# Name: writeArrayToXML
#
# Description:
#    An internal routine for writing an array out as XML.
#
# Arguments:
#    \@: a reference to an array to be written out.
#    $: (optional) a filehandle.  By default it's STDOUT.
#
# Returns:
#    True if successful.
#
sub writeArrayToXML(\@;$) {
	my $self = shift;
	my $data = shift;
	my $fh = shift || *STDOUT;
    my $rc = 1;

	foreach ( @{ $data }) {
		$rc &&= $self->writeToXML( $_, $fh );

	}
	return $rc;
}

# Name: writeHashToXML
#
# Description:
#    An internal routine for writing a hash as XML.
#
# Arguments:
#    \%: a reference to an array to be written out.
#    $: (optional) a filehandle.  By default it's STDOUT.
#
# Returns:
#    True if successful.
#
sub writeHashToXML(\%;$) {
	my $self = shift;
	my $data = shift;
	my $fh = shift || *STDOUT;
    my $rc = 1;

	for my $key ( keys %{$data} ) {
		$rc &&= $self->writeTaggedDataToXML( $key, $data->{$key}, $fh );
	}

	return $rc;
}

# Name: writeTaggedDataToXML
#
# Description:
#	 An internal routine for writing out compound data structures as XML.
#
# Arguments:
#    $: the tagname
#    $: the data.  Currently only is allowed are scalars, references to 
#		scalars arrays and hashes, or nothing (empty entities will be printed).
#    $: (optional) a filehandle.  By default it's STDOUT.
#
# Returns:
#    True if there was no errors in printing, and the data was what is
#    supported.
#
sub writeTaggedDataToXML($$;$) {
	my $self = shift;
	my $tagname = shift;
	my $data = shift;
	my $fh = shift || *STDOUT;

	return $self->writeTaggedArrayToXML($tagname, $data, $fh) if ( ref $data eq "ARRAY" );
	return $self->writeTaggedHashToXML($tagname, $data, $fh) if ( ref $data eq "HASH" );
	return $self->writeTaggedScalarToXML($tagname, $data, $fh) if ( ref $data eq "SCALAR" );
	return $self->writeTaggedNullToXML($tagname, $fh) if ( !defined $data );
	return $self->writeTaggedScalarToXML($tagname, $data, $fh) if ( not ref $data );

	Carp::croak "Not a compound data structure $data";
	return 0;
}

# Name: writeTaggedScalarToXML
#
# Description:
#    An internal method to write out a scalar.
#
# Arguments:
#    $: the tagname
#    $: the scalar data.
#    $: (optional) a filehandle.  By default it's STDOUT.
#
# Returns:
#    True if there were no errors in printing.
#
sub writeTaggedScalarToXML($$;$) {
	my $self = shift;
	my $tagname = shift;
	my $data = shift;
	my $fh = shift || *STDOUT;
	my $endtag;
 	($endtag) = $tagname =~ m/^(\w+)/;	

	return 
		print $fh
			$self->pad(), "<", $tagname, ">", encode( $data ),
			"</", $endtag, ">", "\n";
}

# Name: writeTaggedNullToXML
#
# Description:
#    An internal method to write out an empty entity.  Currently, the
#    the format is <TAG></TAG>, as opposed to the <TAG/> format.
#
# Arguments:
#    $: the tagname
#    $: (optional) a filehandle.  By default it's STDOUT.
#
# Returns:
#    True if there were no errors in printing.
#
sub writeTaggedNullToXML($;$) {
	my $self = shift;
	my $tagname = shift;
	my $fh = shift || *STDOUT;
	my $endtag;
 	($endtag) = $tagname =~ m/^(\w+)/;	

	return 1 if (!$self->{_show_null_values});
	print $fh $self->pad(), "<", $tagname, ">", "</", $endtag, ">", "\n";
}

# Name: writeTaggedArrayToXML
#
# Description:
#    An internal method to write out an array as XML.
#
# Arguments:
#    $: the tagname
#    $: a reference to the array to be written.
#    $: (optional) a filehandle.  By default it's STDOUT.
#
# Returns:
#    True if there were no errors in printing.
#
sub writeTaggedArrayToXML($\@;$) {
	my $self = shift;
	my $tagname = shift;
	my $data = shift;
	my $fh = shift || *STDOUT;
        my $rc;
	my $endtag;
	($endtag) = $tagname =~ m/^(\w+)/; 

	$rc = print $fh $self->pad(), "<", $tagname, ">", "\n";
	$self->{_indentLevel}++;
	foreach ( @{ $data }) {
		$rc &&= $self->writeToXML( $_, $fh );
	}
	$self->{_indentLevel}--;
	$rc &&= print $fh $self->pad(), "</", $endtag, ">", "\n";

	return $rc
}

# Name: writeTaggedHashToXML
#
# Description:
#    An internal method to write out a hash as XML.  If the indices have
#    been specified as part of sorting rule, then these will be used.
#    NOTE: I am intentionally blurring 'keys' and 'indices' because in a
#    sense we are treating a hash as an array by indexing it.
#
# Arguments:
#    $: the tagname
#    $: a reference to the hash to be written.
#    $: (optional) a filehandle.  By default it's STDOUT.
#
# Returns:
#    True if there were no errors in printing.
#
sub writeTaggedHashToXML($\%;$$) {
	my $self = shift;
	my $tagname = shift;
	my $data = shift;
	my $fh = shift || *STDOUT;
	my @keys;
    	my $rc;
	my $endtag;
 	($endtag) = $tagname =~ m/^(\w+)/;	

	# Load up the indicies (sort rule) if found.
	if ( defined( $self->{_sortRules}{$tagname} )) {
		@keys = @{ $self->{_sortRules}{$tagname} };
	}
	else {
		@keys = keys %{$data};
	}

	$rc = print $fh $self->pad(), "<", $tagname, ">", "\n";
	$self->{_indentLevel}++;
	for my $key ( @keys ) {
		if ( $self->{_show_nonexisting_tags} || exists $data->{$key} ) {
			$rc &&= $self->writeTaggedDataToXML( $key, $data->{$key}, $fh );
		}
	}
	$self->{_indentLevel}--;
	$rc &&= print $fh $self->pad(), "</", $endtag, ">", "\n";

	return $rc;
}

# Name: encode
#
# Description:
#    An internal, static method to encode the string.
#    Currently all less-than and greater-than symbols will be translated
#    to &lt; and &gt;.
#
# Arguments:
#    $: the string to be encoded
#
# Returns:
#    The encoded string.
#
sub encode($) {
	my $string = shift;
	$string =~ s/</\&lt;/g;
	$string =~ s/>/\&gt;/g;
	$string =~ s/\&/\&amp;/g;
	return $string;
}
1;
__END__