File Coverage

blib/lib/Rosetta/Model.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

#!perl
use 5.008001;
use utf8;
use strict;
use warnings;

# External packages used by packages in this file, that don't export symbols:
use only 'Parse::RecDescent' => '1.94-'; # TODO: make load of this optional
use only 'Locale::KeyedText' => '1.72.0-';

###########################################################################
###########################################################################

# Constant values used by packages in this file:
use only 'Readonly' => '1.03-';
Readonly my $EMPTY_STR => q{};

###########################################################################
###########################################################################

{ package Rosetta::Model; # package
    use version; our $VERSION = qv('0.724.0');
    # Note: This given version applies to all of this file's packages.
} # package Rosetta::Model

###########################################################################
###########################################################################

{ package Rosetta::Model::Document; # class

    # External packages used by the Rosetta::Model::Document class, that do export symbols:
    use only 'Class::Std' => '0.0.8-';
    use only 'Class::Std::Utils' => '0.0.2-';

    # Attributes of every Rosetta::Model::Document object:
    my %all_nodes_of  :ATTR;
    # Array of Rosetta::Model::Node
    # The set of all Nodes that this Document contains.
    my %root_nodes_of :ATTR;
    # Array of Rosetta::Model::Node
    # List of all Nodes that have no parent Nodes; a sub-set of all_nodes.

    # Entrust the Rosetta::Model::Node class to see our private attributes.
    sub _entrust_attrs_to_node_class {
        # TODO: Add gate code to die if caller not the Node class.
        return (\%all_nodes_of, \%root_nodes_of);
    }

###########################################################################

sub BUILD {
    my ($self, $ident, $arg_ref) = @_;
    my $root_nodes_ref
        = exists $arg_ref->{'root_nodes'} ? $arg_ref->{'root_nodes'} : [];

    $self->_assert_arg_rt_nd_aoh(
        'new', ':@root_nodes?', $root_nodes_ref );

    $all_nodes_of{$ident}  = [];
    $root_nodes_of{$ident} = [];
    for my $root_node (@{$root_nodes_ref}) {
        Rosetta::Model::Node->new({ 'document' => $self, %{$root_node} });
    }

    return;
}

###########################################################################

sub export_as_hash {
    my ($self) = @_;
    return {
        'root_nodes'
            => [map { $_->export_as_hash() }
                @{$root_nodes_of{ident $self}}],
    };
}

###########################################################################

sub _die_with_msg : PRIVATE {
    my ($self, $msg_key, $msg_vars_ref) = @_;
    $msg_vars_ref ||= {};
    $msg_vars_ref->{'CLASS'} = 'Rosetta::Model::Document';
    die Locale::KeyedText::Message->new({
        'msg_key' => $msg_key, 'msg_vars' => $msg_vars_ref });
}

sub _assert_arg_rt_nd_aoh : PRIVATE {
    my ($self, $meth, $arg, $val) = @_;
    $self->_die_with_msg( 'LKT_ARG_UNDEF',
            { 'METH' => $meth, 'ARG' => $arg } )
        if !defined $val;
    $self->_die_with_msg( 'LKT_ARG_NO_ARY',
            { 'METH' => $meth, 'ARG' => $arg, 'VAL' => $val } )
        if ref $val ne 'ARRAY';
    for my $val_elem (@{$val}) {
        $self->_die_with_msg( 'LKT_ARG_ARY_ELEM_UNDEF',
                { 'METH' => $meth, 'ARG' => $arg } )
            if !defined $val_elem;
        $self->_die_with_msg( 'LKT_ARG_ARY_ELEM_NO_HASH',
                { 'METH' => $meth, 'ARG' => $arg, 'VAL' => $val_elem } )
            if ref $val_elem ne 'HASH';
        for my $k ('document', 'parent_node') {
            $self->_die_with_msg(
                    'ROS_M_D_ARG_AOH_TO_CONSTR_CH_ND_HAS_KEY_CONFL',
                    { 'METH' => $meth, 'ARG' => $arg, 'KEY' => $k } )
                if exists $val_elem->{$k};
        }
    }
}

###########################################################################

} # class Rosetta::Model::Document

###########################################################################
###########################################################################

{ package Rosetta::Model::Node; # class

    # External packages used by the Rosetta::Model::Node class, that do export symbols:
    use only 'Class::Std' => '0.0.8-';
    use only 'Class::Std::Utils' => '0.0.2-';
    use Scalar::Util qw( blessed );

    # Attributes of every Rosetta::Model::Node object:
    my %document_of    :ATTR;
    # Rosetta::Model::Document
    # The Document that this Node lives in.
    my %parent_node_of :ATTR;
    # Rosetta::Model::Node
    # The parent Node of this Node, if there is one.
    my %node_type_of   :ATTR;
    # Str
    # What type of Node this is.
    my %attributes_of  :ATTR;
    # Hash(Str) of Any
    # Named attribute values that this Node has, if any.
    my %child_nodes_of :ATTR;
    # Array of Rosetta::Model::Node
    # List of this Node's child Nodes, if there are any.

    # Aliases of attributes of Document objects we are trusted to see:
    my ($all_nodes_of_document, $root_nodes_of_document)
        = Rosetta::Model::Document->_entrust_attrs_to_node_class();

###########################################################################

sub BUILD {
    my ($self, $ident, $arg_ref) = @_;
    my $document    = $arg_ref->{'document'};
    my $parent_node = $arg_ref->{'parent_node'}; # or defaults to undef
    my $node_type   = $arg_ref->{'node_type'};
    my $attributes_ref
        = exists $arg_ref->{'attributes'} ? $arg_ref->{'attributes'} : {};
    my $child_nodes_ref
        = exists $arg_ref->{'child_nodes'}
            ? $arg_ref->{'child_nodes'} : [];

    $self->_assert_arg_doc( 'new', ':$document!', $document );
    if (defined $parent_node) {
        $self->_assert_arg_node_assume_def(
            'new', ':$parent_node?', $parent_node );
    }
    $self->_assert_arg_str( 'new', ':$node_type!', $node_type );
    $self->_assert_arg_hash( 'new', ':%attributes?', $attributes_ref );
    $self->_assert_arg_ch_nd_aoh(
        'new', ':@child_nodes?', $child_nodes_ref );

    $document_of{$ident} = $document;
    push @{$all_nodes_of_document->{ident $document}}, $self;
    if (defined $parent_node) {
        $parent_node_of{$ident} = $parent_node;
        push @{$child_nodes_of{ident $parent_node}}, $self;
    }
    else {
        push @{$root_nodes_of_document->{ident $document}}, $self;
    }
    $node_type_of{$ident}   = $node_type;
    $attributes_of{$ident}  = {%{$attributes_ref}};
    $child_nodes_of{$ident} = [];
    for my $child_node (@{$child_nodes_ref}) {
        (ref $self)->new({
            'document'    => $document,
            'parent_node' => $self,
            %{$child_node},
        });
    }

    return;
}

###########################################################################

sub export_as_hash {
    my ($self) = @_;
    my $ident = ident $self;
    return {
        'node_type'   => $node_type_of{$ident},
        'attributes'  => {%{$attributes_of{$ident}}},
        'child_nodes'
            => [map { $_->export_as_hash() }
                @{$child_nodes_of{$ident}}],
    };
}

###########################################################################

sub _die_with_msg : PRIVATE {
    my ($self, $msg_key, $msg_vars_ref) = @_;
    $msg_vars_ref ||= {};
    $msg_vars_ref->{'CLASS'} = 'Rosetta::Model::Node';
    die Locale::KeyedText::Message->new({
        'msg_key' => $msg_key, 'msg_vars' => $msg_vars_ref });
}

sub _assert_arg_str : PRIVATE {
    my ($self, $meth, $arg, $val) = @_;
    $self->_die_with_msg( 'LKT_ARG_UNDEF',
            { 'METH' => $meth, 'ARG' => $arg } )
        if !defined $val;
    $self->_die_with_msg( 'LKT_ARG_EMP_STR',
            { 'METH' => $meth, 'ARG' => $arg } )
        if $val eq $EMPTY_STR;
}

sub _assert_arg_hash : PRIVATE {
    my ($self, $meth, $arg, $val) = @_;
    $self->_die_with_msg( 'LKT_ARG_UNDEF',
            { 'METH' => $meth, 'ARG' => $arg } )
        if !defined $val;
    $self->_die_with_msg( 'LKT_ARG_NO_HASH',
            { 'METH' => $meth, 'ARG' => $arg, 'VAL' => $val } )
        if ref $val ne 'HASH';
    $self->_die_with_msg( 'LKT_ARG_HASH_KEY_EMP_STR',
            { 'METH' => $meth, 'ARG' => $arg } )
        if exists $val->{$EMPTY_STR};
}

sub _assert_arg_doc : PRIVATE {
    my ($self, $meth, $arg, $val) = @_;
    $self->_die_with_msg( 'LKT_ARG_UNDEF',
            { 'METH' => $meth, 'ARG' => $arg } )
        if !defined $val;
    $self->_die_with_msg( 'LKT_ARG_NO_EXP_TYPE', { 'METH' => $meth,
            'ARG' => $arg, 'EXP_TYPE' => 'Rosetta::Model::Document',
            'VAL' => $val } )
        if !blessed $val or !$val->isa( 'Rosetta::Model::Document' );
}

sub _assert_arg_node_assume_def : PRIVATE {
    my ($self, $meth, $arg, $val) = @_;
    $self->_die_with_msg( 'LKT_ARG_NO_EXP_TYPE', { 'METH' => $meth,
            'ARG' => $arg, 'EXP_TYPE' => 'Rosetta::Model::Node',
            'VAL' => $val } )
        if !blessed $val or !$val->isa( 'Rosetta::Model::Node' );
}

sub _assert_arg_ch_nd_aoh : PRIVATE {
    my ($self, $meth, $arg, $val) = @_;
    $self->_die_with_msg( 'LKT_ARG_UNDEF',
            { 'METH' => $meth, 'ARG' => $arg } )
        if !defined $val;
    $self->_die_with_msg( 'LKT_ARG_NO_ARY',
            { 'METH' => $meth, 'ARG' => $arg, 'VAL' => $val } )
        if ref $val ne 'ARRAY';
    for my $val_elem (@{$val}) {
        $self->_die_with_msg( 'LKT_ARG_ARY_ELEM_UNDEF',
                { 'METH' => $meth, 'ARG' => $arg } )
            if !defined $val_elem;
        $self->_die_with_msg( 'LKT_ARG_ARY_ELEM_NO_HASH',
                { 'METH' => $meth, 'ARG' => $arg, 'VAL' => $val_elem } )
            if ref $val_elem ne 'HASH';
        for my $k ('document', 'parent_node') {
            $self->_die_with_msg(
                    'ROS_M_N_ARG_AOH_TO_CONSTR_CH_ND_HAS_KEY_CONFL',
                    { 'METH' => $meth, 'ARG' => $arg, 'KEY' => $k } )
                if exists $val_elem->{$k};
        }
    }
}

###########################################################################

} # class Rosetta::Model::Node

###########################################################################
###########################################################################

1; # Magic true value required at end of a reuseable file's code.
__END__