use utf8;
use strict;
use warnings;
no warnings qw(uninitialized);


#================================================================
package XML::Pastor::Util;

use XML::LibXML;
use Exporter;

our @ISA = qw (Exporter);
our @EXPORT = qw();
our @EXPORT_OK = qw( 	mergeHash 
						getAttributeHash
						getChildrenHashDOM
						
						module_path
											
						slurp_file
						sprint_xml_doc
						sprint_xml_element
						
						validate_date
						validate_time
					);

#------------------------------------------------------------------
# merge h2 into h1;
#------------------------------------------------------------------
sub mergeHash {
	my $h1 	= shift;
	my $h2	= shift;
	
	for my $key (keys %$h2) {
		$h1->{$key}=$h2->{$key};
	}
	
	return $h1;
}


#------------------------------------------------------------
# This is a utility function (not a method) that will get all the attributes
# of an DOM element into a hash and return that hash.
#-------------------------------------------------------------
sub getAttributeHash {
	my $node 	= shift;
	my $attribs = {}; 
	
	unless (UNIVERSAL::isa($node, "XML::LibXML::Element")) {
		return undef;
	}
	
	my @attributes=$node->attributes();
	foreach my $attribute (@attributes) {
		next unless defined $attribute;
		$attribs->{	$attribute->nodeName()} = $attribute->value();
	}
	return $attribs;	
}


#------------------------------------------------------------
# This is a utility function (not a method) that will get all the children
# of an DOM element into a hash of arrays and return that hash.
#-------------------------------------------------------------
sub getChildrenHashDOM {
	my $node 	= shift;
	my $result 	= {}; 
	
	unless (UNIVERSAL::isa($node, "XML::LibXML::Element")) {
		return undef;
	}

	my @children = grep {UNIVERSAL::isa($_, "XML::LibXML::Element")} $node->childNodes();	
	foreach my $child (@children) {
		next unless defined $child;
		my $name = $child->localName();
		unless (defined($result->{$name})) {
			$result->{$name} = [];
		}
		push @{$result->{$name}}, $child;
	}
	
	return $result;	
}



#------------------------------------------------------------
# A DEBUG routine that prints out an XMLish document given a DOM document.
#-------------------------------------------------------------
sub sprint_xml_doc() {
	my $dom = shift;
	my $s = "";
	
	$s .= "\n<xml version=\"1.0\">\n";
	my $root=$dom->documentElement();
	$s .= sprint_xml_element($root);
	$s .=  "\n</xml>\n";	
	return $s;
}


#------------------------------------------------------------
# A DEBUG routine that returns an XMLish element string given a DOM element.
#-------------------------------------------------------------
sub sprint_xml_element($;$);   # warning if the compiler doesn't see a prototype in a recursive call.
sub sprint_xml_element($;$) {
	my $elem = shift;
	my $indent=shift || 0;
	my $s = "";
	my $name = $elem->localName();  #$elem->nodeName();
	my @attributes=$elem->attributes();
	$s .= _sprint_indent($indent);
	$s .= "<$name ";
	foreach my $attribute (@attributes) {
		next unless defined $attribute;
		$s .= $attribute->nodeName() . "=\"" .$attribute->value() . "\" ";
	}
	my @children = grep {UNIVERSAL::isa($_, "XML::LibXML::Element")} $elem->childNodes();
	unless (scalar(@children)) {
		$s .= "/>";		
	}else {
		$s .=  ">";	
		foreach my $child (@children) {
			$s .= sprint_xml_element($child, $indent+1);
		}
		$s .= _sprint_indent($indent);	
		$s .=  "</$name>";		
	}	
	return $s;
}


#------------------------------------------------------------
# A DEBUG routine that helps the print_xml_element family
#-------------------------------------------------------------
sub _sprint_indent(){
	my $indent = shift;
	my $s = "";
	$s .= "\n"; 
	for(my $i=0; $i<$indent;$i++) {
		$s.= "  ";
	}
	return $s;
}

#------------------------------------------------------------
# Slurps an entire file into memory and returns the resulting string
#-------------------------------------------------------------
sub slurp_file {
	my $file	= shift;
	
	local( $/ ) ;
    open( my $fh, $file ) or die "XML::Pastor::Util : slurp_file : Can't open file $file\n";
    return <$fh>;
}

#------------------------------------------------------------
# module_path
# Given a module name (without the .pm) and a destination directory,
# Compute the file path where the module would be written to. 
#-------------------------------------------------------------
sub module_path {
	my $args 			= {@_};
	my $module 			= $args->{module}  || die "Need a module name!";
	my $destination 	= $args->{destination}  || "/tmp/lib/perl/";
	
	# Add a trailing slash if necessary.
	$destination .= '/' if ($destination && ($destination !~ /\/$/));
	
	# get ride of any trailing columns.
	while ($module =~ /:$/) {
		$module =~ s/:$//;
	}
			
	my $file	= $module;
	$file = $destination . $file . '.pm';
	$file =~ s/::/\//g;
	
	return $file;
}

#------------------------------------------------
# code taken from XML::Schema::Validate who took it from Date::Simple
#--------------------------------------------------
our @days_in_month = ([0,31,28,31,30,31,30,31,31,30,31,30,31],
                     [0,31,29,31,30,31,30,31,31,30,31,30,31]);

sub validate_date ($$$) {
    my ($y, $m, $d)= @_;
        
    # any +ve integral year is valid
    return 0 if $y != abs int $y;
    return 0 unless 1 <= $m and $m <= 12;
    return 0 unless 1 <= $d and $d <=$days_in_month[_leap_year($y)][$m];
    return 1;
}

sub _leap_year {
    my $y = shift;
    return (($y%4==0) and ($y%400==0 or $y%100!=0)) || 0;
}

#------------------------------------------------
sub validate_time ($$$) {
	my ($h, $m, $s) = @_;
		
    return 0 if $h != abs int $h;
    return 0 if $m != abs int $m;
    return 0 unless 0 <= $h and $h <= 23;
    return 0 unless 0 <= $m and $m <= 59;
    return 0 unless 0 <= $s and $s <= 61;    	# Leap seconds can be upto 61!!!
    return 1;
}


#

1;