package RDA::Object::Data;

# $Id: Data.pm,v 1.10 2008/02/25 14:55:26 mschenke Exp $
# ARCS: $Header: /home/cvs/repository/RDA_4/src/scripting/lib/RDA/Object/Data.pm,v 1.10 2008/02/25 14:55:26 mschenke Exp $
#
# Change History
# 20080225  MSC  Change the copyright notice.

=head1 NAME

RDA::Object::Data - Class Used for Complex Data Structures.

=head1 SYNOPSIS

require RDA::Object::Data;

=head1 DESCRIPTION

The objects of the C<RDA::Object::Data> class are used for storing complex data
structures.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
}

# Define the global public variables
use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);

# Define the global private variables
my $TRC = 'TRACE> ';

# Report the module version number
sub Version
{ $VERSION;
}

=head2 S<$h = RDA::Object::Data-E<gt>new(...)>

The object constructor. You can provide some initial content as arguments.

C<RDA::Object:Data> is represented by a blessed hash reference.

=cut

sub new
{ my $slf   = shift;
  my $class = ref($slf) || $slf;

  # Return the object reference
  $slf = bless {@_}, $class;
}

=head2 S<$h-E<gt>as_string>

This method returns a string listing all hash keys.

=cut

sub as_string
{ my $slf = shift;

  join(',', sort keys(%$slf));
}

=head2 S<$h-E<gt>copy>

This method returns a copy of the data structure.

=cut

sub copy
{ my $src = shift;

  _copy_hash($src->new, $src, {}, 0);
}

=head2 S<$h-E<gt>dump>

This method dumps the content of the data structure.

=cut

sub dump
{ my $slf = shift;
  my $lvl = shift || 0;
  my ($pre, $ref, $val);

  $pre = '  ' x $lvl;
  $ref = ref($slf);
  if ($ref eq 'HASH')
  { print $pre."{\n";
    _dump_hash($slf, $lvl, {$slf => "$ref=Data()"}, '');
    print $pre."}\n";
  }
  elsif ($ref)
  { print $pre."bless( {\n";
    _dump_hash($slf, $lvl, {$slf => "$ref=Data()"}, '');
    print $pre."}, '".ref($slf)."')\n";
  }
  else
  { print "$pre'$slf'\n";
  }
  $slf;
}

sub _dump_array
{ my ($slf, $lvl, $tbl, $arg) = @_;
  my ($cnt, $pre, $ref);

  $pre = '  ' x ++$lvl;
  $cnt = 0;
  foreach my $val (@$slf)
  { $ref = ref($val);
    if (exists($tbl->{$val}))
    { print $pre.$tbl->{$val}."\n";
    }
    elsif ($ref eq 'ARRAY')
    { print $pre."[\n";
      $tbl->{$val} = "$ref=Data($arg$cnt)";
      _dump_array($val, $lvl, $tbl, "$arg$cnt,");
      print "$pre]\n";
    }
    elsif ($ref eq 'HASH')
    { print $pre."{\n";
      $tbl->{$val} = "$ref=Data($arg$cnt)";
      _dump_hash($val, $lvl, $tbl, "$arg$cnt,");
      print "$pre}\n";
    }
    elsif ($ref eq 'RDA::Object::Data')
    { print $pre."bless( {\n";
      $tbl->{$val} = "$ref=Data($arg$cnt)";
      _dump_hash($val, $lvl, $tbl, "$arg$cnt,");
      print "$pre}, '$ref')\n";
    }
    elsif ($ref eq 'RDA::Value')
    { $val->dump($lvl);
    }
    elsif ($ref)
    { print "$pre$val\n";
    }
    elsif (defined($val))
    { print "$pre'$val'\n";
    }
    else
    { print $pre."undef\n";
    }
    ++$cnt;
  }
}

sub _dump_hash
{ my ($slf, $lvl, $tbl, $arg) = @_;
  my ($pre, $ref, $val);

  $pre = '  ' x ++$lvl;
  foreach my $key (sort keys(%$slf))
  { $ref = ref($val = $slf->{$key});
    if ($ref && exists($tbl->{$val}))
    { print "$pre'$key' => ".$tbl->{$val}."\n";
    }
    elsif ($ref eq 'ARRAY')
    { print "$pre'$key' => [\n";
      $tbl->{$val} = "$ref=Data($arg'$key')";
      _dump_array($val, $lvl, $tbl, "$arg'$key',");
      print "$pre]\n";
    }
    elsif ($ref eq 'HASH')
    { print "$pre'$key' => {\n";
      $tbl->{$val} = "$ref=Data($arg'$key')";
      _dump_hash($val, $lvl, $tbl, "$arg'$key',");
      print "$pre}\n";
    }
    elsif ($ref eq 'RDA::Object::Data')
    { print "$pre'$key' => bless( {\n";
      $tbl->{$val} = "$ref=Data($arg'$key')";
      _dump_hash($val, $lvl, $tbl, "$arg'$key',");
      print "$pre}, '$ref')\n";
    }
    elsif ($ref eq 'RDA::Value')
    { $val->dump($lvl, "'$key' => ");
    }
    elsif ($ref)
    { print "$pre'$key' => $val\n";
    }
    elsif (defined($val))
    { print "$pre'$key' => '$val'\n";
    }
    else
    { print "$pre'$key' => undef\n";
    }
  }
}

=head2 S<$h-E<gt>eval>

This method evaluates a data structure and returns a new data structure that
can be used in external Perl modules.

=cut

sub eval
{ my $src = shift;

  _copy_hash($src->new, $src, {}, 1);
}

# --- Internal functions ------------------------------------------------------

# Copy an array
sub _copy_array
{ my ($dst, $src, $tbl, $flg) = @_;
  my ($ref);

  $tbl->{$src} = $dst;
  foreach my $val (@$src)
  { $ref = ref($val);
    if ($flg && $ref eq 'RDA::Value')
    { push(@$dst, $val->eval_as_scalar);
    }
    elsif ($ref && exists($tbl->{$val}))
    { push(@$dst, $tbl->{$val});
    }
    elsif ($ref eq 'ARRAY')
    { push(@$dst, _copy_array([], $val, $tbl, $flg));
    }
    elsif ($ref eq 'HASH' || $ref eq 'RDA::Object::Data')
    { push(@$dst, _copy_hash({}, $val, $tbl, $flg));
    }
    else
    { push(@$dst, $val);
    }
  }
  $dst;
}

# Copy a hash
sub _copy_hash
{ my ($dst, $src, $tbl, $flg) = @_;
  my ($ref, $val);

  $tbl->{$src} = $dst;
  foreach my $key (keys(%$src))
  { $ref = ref($val = $src->{$key});
    if ($flg && $ref eq 'RDA::Value')
    { $dst->{$key} = $val->eval_as_scalar;
    }
    elsif ($ref && exists($tbl->{$val}))
    { $dst->{$key} = $tbl->{$val};
    }
    elsif ($ref eq 'ARRAY')
    { $dst->{$key} = _copy_array([], $val, $tbl, $flg);
    }
    elsif ($ref eq 'HASH' || $ref eq 'RDA::Object::Data')
    { $dst->{$key} = _copy_hash({}, $val, $tbl, $flg);
    }
    else
    { $dst->{$key} = $val;
    }
  }
  $dst;
}

1;

__END__

=head1 SEE ALSO

See also L<RDA::Agent|RDA::Agent>, L<RDA::Block|RDA::Block>,
L<RDA::Value|RDA::Value>,
L<RDA::Object::Buffer|RDA::Object::Buffer>,
L<RDA::Object::Html|RDA::Object::Html>,
L<RDA::Object::Parser|RDA::Object::Parser>,
L<RDA::Object::Request|RDA::Object::Request>,
L<RDA::Object::Response|RDA::Object::Response>,
L<RDA::Object::Sgml|RDA::Object::Sgml>,
L<RDA::Object::UsrAgent|RDA::Object::UsrAgent>,
L<RDA::Object::Xml|RDA::Object::Xml>,
L<RDA::Macro::Data|RDA::Macro::Data>.

=head1 COPYRIGHT NOTICE

Copyright (c) 2002-2008, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of Oracle
Corporation and/or its affiliates. Other names may be trademarks of their
respective owners.

=cut