# $Header: Ptdpm4.pm 27-sep-2004.12:31:00 mgoodric Exp $
#
# Package : Ptdpm4.pm
#
# Copyright (c) 2002, 2004, Oracle. All rights reserved.  
#
#   NAME
#       Ptdpm4.pm
#
#   DESCRIPTION
#       Common XML utilities
#
#   NOTES
#
#   MODIFIED     (MM/DD/YY)
#      mgoodric   09/27/04 - code cleanup 
#      mgoodric   04/01/04 - Fix tagString variable
#      mgoodric   03/21/04 - Linux cleanup
#      mgoodric   01/30/04 - fix dropping last character when it's an entity
#      mgoodric   07/14/03 - fix for converting to UTF8 data
#      mgoodric   06/16/03 - fix converting Solaris timezone to JAVA timezones
#      mgoodric   04/07/03 - fix finding MAC address
#      xxu        06/25/02 - remove /usr/local/bin/perl
#      mgoodric   02/14/02 - Make scripts more portable
#      goramamo   12/15/01 - Creation
#
##*************************************************************

use strict;

package Ptdpm4;

use Carp;
require 5.005;

#require 5.6.1;
require Exporter;

use Ptdpm2;

#******************************************
#   Export Subroutines
#******************************************

@Ptdpm4::ISA    = ('Exporter');
@Ptdpm4::EXPORT = qw(
  &checkXMLInternalEntities
  &checkXMLInternalEntitiesInString
  &checkXMLInternalEntitiesIn2DimArray
  &tagString
  &tagArray
  &convToUTF8
  );

#******************************************
#     Global Variables
#******************************************

use constant NIL => '';

#******************************************
#     Exported Subroutines
#******************************************

sub checkXMLInternalEntities
{
    my (@in) = @_;
    my $i    = 0;
    my $size = 0;

    $size = scalar(@in);

    for ($i = 0 ; $i < $size ; $i++)
    {
        $in[$i] = checkXMLInternalEntitiesInString($in[$i]);
    }

    return @in;
}

sub checkXMLInternalEntitiesInString($)
{
    my ($in) = @_;

    if (!defined $in || length($in) == 0) { return NIL; }

    #print "The string was: \"$in\"\n"; #debug
    $in =~ s/\&/&amp;/g
      if ($in =~ m/\&/);    # must be done first for obvious reasons
    $in =~ s/\'/&apos;/g if ($in =~ m/\'/);
    $in =~ s/\"/&quot;/g if ($in =~ m/\"/);
    $in =~ s/\</&lt;/g   if ($in =~ m/\</);
    $in =~ s/\>/&gt;/g   if ($in =~ m/\>/);

    #print "The string  is: \"$in\"\n"; #debug

    return convToUTF8($in);
}

sub checkXMLInternalEntitiesIn2DimArray
{
    my (@in) = @_;
    my $i    = 0;
    my $l    = 0;
    my $size = 0;

    $size = scalar(@in);

    for ($i = 0 ; $i < $size ; $i++)
    {
        for ($l = 0 ; $l < 5 ; $l++)
        {
            $in[$i][$l] = checkXMLInternalEntitiesInString($in[$i][$l]);
        }
    }

    return @in;
}

sub tagString($)
{
    my ($string) = @_;
    my ($tag, $value) = split ($Ptdpm2::SEP, $string);

    return Ptdpm2::typeValue($tag, $value);
}

sub tagArray
{
    my (@array) = @_;
    my $size = scalar(@array);
    my @xml = ();

    for (my $i = 0 ; $i < $size ; $i++)
    {
        $xml[$i] = tagString($array[$i]);
    }

    return (@xml);
}

sub convToUTF8($)
{
    my ($value) = @_;
    my $num   = 0;
    my $utf8  = NIL;

    for (my $i = 0 ; $i < length($value) ; $i++)
    {
        $num = ord(substr($value, $i, 1));
        if ($num < 0x80)
        {
            $utf8 .= chr($num);
        }
        else
        {
            $utf8 .= chr(0xC0 | (($num >> 6) & 0x03));
            $utf8 .= chr(0x80 | ($num & 0x3F));
        }
    }

    return $utf8;
}

1;

# End of the Program