view release on metacpan or  search on metacpan

lib/App/Reference.pm  view on Meta::CPAN

#############################################################################
## $Id: Reference.pm 9683 2007-06-26 15:30:18Z spadkins $
#############################################################################

package App::Reference;
$VERSION = (q$Revision: 9683 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn

use strict;

use App;

=head1 NAME

App::Reference - a Perl reference, blessed so it can be accessed with methods

=head1 SYNOPSIS

   use App::Reference;

   $ref = App::Reference->new();
   $ref = App::Reference->new("file" => $file);
   print $ref->dump(), "\n";   # use Data::Dumper to spit out the Perl representation

   # accessors
   $property_value = $ref->get($property_name);
   $branch = $ref->get_branch($branch_name,$create_flag);  # get hashref
   $ref->set($property_name, $property_value);

   # on-demand loading helper methods (private methods)
   $ref->overlay($ref2);        # merge the two structures using overlay rules
   $ref->overlay($ref1, $ref2);  # merge $ref2 onto $ref1
   $ref->graft($branch_name, $ref2);  # graft new structure onto branch

=head1 DESCRIPTION

App::Reference is a very thin class which wraps a few simple
methods around a perl reference which may contain a multi-level data
structure.

=cut

#############################################################################
# CLASS
#############################################################################

=head1 Class: App::Reference

    * Throws: App::Exception
    * Since:  0.01

=head2 Requirements

The App::Reference class satisfies the following requirements.

    o Minimum performance penalty to access perl data
    o Ability to bless any reference into this class
    o Ability to handle ARRAY and HASH references

=cut

#############################################################################
# CONSTRUCTOR METHODS
#############################################################################

=head1 Constructor Methods:

=cut

#############################################################################
# new()
#############################################################################

=head2 new()

This constructor is used to create Reference objects.
Customized behavior for a particular type of Reference
is achieved by overriding the _init() method.

    * Signature: $ref = App::Reference->new($array_ref)
    * Signature: $ref = App::Reference->new($hash_ref)
    * Signature: $ref = App::Reference->new("array",@args)
    * Signature: $ref = App::Reference->new(%named)
    * Param:     $array_ref          []
    * Param:     $hash_ref           {}
    * Return:    $ref                App::Reference
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage:

    use "App::Reference";

lib/App/Reference.pm  view on Meta::CPAN

                    return(undef);
                }
            }
            else {
                $branch = $branch->{$branch_piece};
            }
        }
        $sub_branch_name .= $type if ($type eq ".");
    }
    return $branch;
}

#############################################################################
# set()
#############################################################################

=head2 set()

    * Signature: $ref->get($property_name, $property_value);
    * Param:     $property_name    string
    * Param:     $property_value   string
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage: 

    $dbi    = $ref->get("Repository.default.dbi");
    $dbuser = $ref->get("Repository{default}{dbuser}");
    $dbpass = $ref->get("Repository.default{dbpass}");

=cut

sub set {
    print "set(@_)\n" if ($App::DEBUG);
    my ($self, $property_name, $property_value, $ref) = @_;
    $ref = $self if (!defined $ref);

    my ($branch_name, $attrib, $type, $branch, $cache_ok);
    if ($property_name =~ /^(.*)([\.\{\[])([^\.\[\]\{\}]+)([\]\}]?)$/) {
        $branch_name = $1;
        $type = $2;
        $attrib = $3;
        $cache_ok = (ref($ref) ne "ARRAY" && $ref eq $self);
        $branch = $ref->{_branch}{$branch_name} if ($cache_ok);
        $branch = $self->get_branch($1,1,$ref) if (!defined $branch);
    }
    else {
        $branch = $ref;
        $attrib = $property_name;
    }

    if (ref($branch) eq "ARRAY") {
        $branch->[$attrib] = $property_value;
    }
    else {
        $branch->{$attrib} = $property_value;
    }
}

#############################################################################
# overlay()
#############################################################################

=head2 overlay()

    * Signature: $ref->overlay($ref2);
    * Signature: $ref->overlay($ref1, $ref2);
    * Param:     $ref1      {}
    * Param:     $ref2      {}
    * Return:    void
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage: 

    # merge the two config structures using overlay rules
    $ref->overlay($ref2);

    # merge $ref2 onto $ref1
    $ref->overlay($ref1, $ref2);

NOTE: right now, this just copies top-level keys of a hash reference
from one hash to the other.

TODO: needs to nested/recursive overlaying

=cut

sub overlay {
    &App::sub_entry if ($App::trace);
    my ($self, $ref1, $ref2) = @_;
    if (!defined $ref2) {
        $ref2 = $ref1;
        $ref1 = $self;
    }
    my $ref1type = ref($ref1);
    my $ref2type = ref($ref2);
    if ($ref1type eq "" || $ref2type eq "") {
        # scalar: nothing to do
    }
    elsif ($ref1type eq "ARRAY" || $ref2type eq "ARRAY") {
        # array: nothing to do
    }
    else {  # assume they are both hashes
        foreach my $key (keys %$ref2) {
            if (!exists $ref1->{$key}) {
                $ref1->{$key} = $ref2->{$key};
            }
            else {
                $ref1type = ref($ref1->{$key});
                if ($ref1type && $ref1type ne "ARRAY") {
                    $ref2type = ref($ref2->{$key});
                    if ($ref2type && $ref2type ne "ARRAY") {
                        $self->overlay($ref1->{$key}, $ref2->{$key});
                    }
                }
            }
        }
    }
    &App::sub_exit() if ($App::trace);
}

#############################################################################
# graft()
#############################################################################

=head2 graft()

    * Signature: $ref->graft($branch_name, $ref2);
    * Param:     $branch_name   string
    * Param:     $ref2       {}
    * Return:    void
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage: 

    # graft new config structure onto branch
    $ref->graft($branch_name, $ref2);

=cut

sub graft {
}

#############################################################################
# dump()
#############################################################################

=head2 dump()

    * Signature: $perl = $ref->dump();
    * Param:     void
    * Return:    $perl      text
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage: 

    $ref = $context->config();
    print $ref->dump(), "\n";

=cut

use Data::Dumper;

sub dump {
    my ($self, $ref) = @_;
    $ref = $self if (!$ref);
    my $d = Data::Dumper->new([ $ref ], [ "ref" ]);
    $d->Indent(1);
    return $d->Dump();
}