# RegEntry.pm: A Simple Perl Version of the BRM Registry Object

package RDA::Extern::RegEntry;

# $Id: RegEntry.pm,v 1.3 2015/05/08 18:31:05 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Extern/RegEntry.pm,v 1.3 2015/05/08 18:31:05 RDA Exp $
#
# Change History
# 20140507  MSC  Modify address management.

=for stopwords IntegRate

=head1 NAME

RDA::Extern::RegEntry - A Simple Perl Version of the IntegRate Registry Object

=head1 SYNOPSIS

 require RDA::Extern::RegEntry;

=head1 DESCRIPTION

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA);
$VERSION = sprintf('%d.%02d', q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(Exporter);

# Report the package version
sub Version
{ return $VERSION;
}

=head2 S<$RDA::Extern::RegEntry-E<gt>new($name)>

Object constructor. It takes the object identifier as an argument.

C<RDA::Extern::RegEntry> is represented by a blessed hash reference. The
following special keys are used:

=over 15

=item S<    B<'all'> > Sorted list of subnodes

=item S<    B<'chl'> > Subnode hash

=item S<    B<'oid'> > Name of the object

=item S<    B<'par'> > Reference of the parent node

=item S<    B<'val'> > Optional value, which can be stored in the object

=back

=cut

sub new
{ my ($cls, $nam) = @_;

  return bless {
    all => [],
    oid => $nam,
    }, $cls;
}

=head2 S<$h-E<gt>add_node($node)>

This method adds a new node to the object.

=cut

sub add_node
{ my ($slf, $nod) = @_;

  $slf->{'chl'}->{$nod->get_oid} = $nod;
  push(@{$slf->{'all'}}, $nod);
  return $nod->{'par'} = $slf;
}

=head2 S<$h-E<gt>add_empty_node($address)>

This method adds an empty node for the given address.

=cut

sub add_empty_node
{ my ($slf, $adr) = @_;
  my ($cur, $nam, $nod, @adr);

  ($cur, @adr) = split(/\./, $adr, 3);
  die "$cur is not me in add_empty_node($adr)\n" unless $cur eq $slf->{'oid'};
  return $slf unless @adr;

  if (exists($slf->{'chl'}->{$nam = shift(@adr)}))
  { $nod = $slf->{'chl'}->{$nam};
  }
  else
  { $slf->add_node($nod = RDA::Extern::RegEntry->new($nam));
  }
  return $nod->add_empty_node(join(q{.}, $nam, @adr));
}

=head2 S<$h-E<gt>find_node($name)>

This method finds an object in the node list.

This method searches only the given name in own subnode list. For a deep
search, use the C<find_deep_node> method.

=cut

sub find_node
{ my ($slf, $nam) = @_;

  return $slf->{'chl'}->{$nam};
}

=head2 S<$h-E<gt>find_deep_node($address)>

This method find an object in the node list.

It searches the entire registry for the given address. The address must start
with the object name on which the function is called.

Example: If we search for C<this.is.an.example>, then the search function must
be called on the object with the name C<this>. The method tries to find a node
with the name C<is> in its subnodes. If the subnode is found, then the method
makes a recursive call on the node with the search argument C<is.an.example>.

=cut

sub find_deep_node
{ my ($slf, $adr) = @_;
  my ($cur, $nam, @adr);

  ($cur, @adr) = split(/\./, $adr, 3);
  die "$cur is not me in find_deep_mode($adr)\n" unless $cur eq $slf->{'oid'};
  return !@adr ?
           $slf :
         exists($slf->{'chl'}->{$nam = shift(@adr)}) ?
           $slf->{'chl'}->{$nam}->find_deep_node(join(q{.}, $nam, @adr)) :
         undef;
}

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

This method returns the list of subnodes.

=cut

sub get_childs
{ return @{shift->{'all'}};
}

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

This method returns the node name.

=cut

sub get_oid
{ return shift->{'oid'};
}

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

This method returns the node path. For example, C<root.node.subnode>.

=cut

sub get_path
{ my ($slf) = @_;

  return exists($slf->{'par'})
    ? $slf->{'par'}->get_path.q{.}.$slf->{'oid'}
    : $slf->{'oid'};
}

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

This method returns the node value.

=cut

sub get_value
{ my ($slf) = @_;

  return exists($slf->{'val'}) ? $slf->{'val'} : undef;
}

=head2 S<$h-E<gt>set_value($value)>

This method sets the node value.

=cut

sub set_value
{ my ($slf, $val) = @_;

  $val =~ s/^ *//g;
  $val =~ s/ *$//g;
  return $slf->{'val'} = $val;
}

=head2 S<$h-E<gt>set_value([$prefix])>

This method writes the tree.

=cut

sub write_tree
{ my ($slf, $pre) = @_;

  $pre = q{} unless defined($pre);
  print $pre.$slf->{'oid'};
  if (exists($slf->{'val'}))
  { print q{ = }.$slf->{'val'}."\n";
  }
  elsif (exists($slf->{'chl'}))
  { print "\n".$pre."{\n";
    foreach my $nod (@{$slf->{'all'}})
    { $nod->write_tree($pre.q{  });
    }
    print $pre."}\n";
  }
  else
  { print "{ }\n";
  }
  return;
}

1;

=head1 COPYRIGHT NOTICE

Copyright (c) 1996, 2016, Oracle and/or its affiliates. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle and Java are registered trademarks of Oracle and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut