view release on metacpan or  search on metacpan

lib/Config/Model/ObjTreeScanner.pm  view on Meta::CPAN

#
# This file is part of Config-Model
#
# This software is Copyright (c) 2005-2022 by Dominique Dumont.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::ObjTreeScanner 2.163;

use 5.20.0;
use strict;
use warnings;

use Config::Model::Exception;
use Scalar::Util qw/blessed/;
use Log::Log4perl qw(get_logger :levels);
use Carp qw/carp croak confess cluck/;
use Carp::Assert::More;

use feature qw/postderef signatures/;
no warnings qw/experimental::signatures experimental::postderef/;

my $logger = get_logger("ObjTreeScanner");

my @value_cb =
    map { $_ . '_value_cb' } qw/boolean dir enum file string uniline integer number reference/;

sub new ($type, %args) {
    my $self = { auto_vivify => 1, check => 'yes' };
    bless $self, $type;

    $self->{leaf_cb} = delete $args{leaf_cb}
        or croak __PACKAGE__, "->new: missing leaf_cb parameter";

    # TODO: switch to warning in 2027
    if (delete $args{fallback}) {
        my ($package, $filename, $line) = caller;
        $logger->info("fallback parameter is deprecated. Called from $filename:$line");
    }

    # we may use leaf_cb
    $self->create_default_callbacks();

    # get all call_backs
    foreach my $param (
        qw/check node_element_cb hash_element_cb
        list_element_cb check_list_element_cb node_content_cb
        node_content_hook list_element_hook hash_element_hook
        auto_vivify up_cb/, @value_cb
        ) {
        $self->{$param} = $args{$param} if defined $args{$param};
        delete $args{$param};    # may exists but be undefined
        croak __PACKAGE__, "->new: missing $param parameter"
            unless defined $self->{$param};
    }

    # this parameter is optional and does not need a fallback
    $self->{node_dispatch_cb} = delete $args{node_dispatch_cb} || {};

    croak __PACKAGE__, "->new: node_dispatch_cb is not a hash ref"
        unless ref( $self->{node_dispatch_cb} ) eq 'HASH';

    croak __PACKAGE__, "->new: unexpected check: $self->{check}"
        unless $self->{check} =~ /yes|no|skip/;

    croak __PACKAGE__, "->new: unexpected parameter: ", join( ' ', keys %args )
        if scalar %args;

    return $self;
}

# internal
sub create_default_callbacks ($self) {
    foreach my $item (qw/node_content_hook hash_element_hook list_element_hook/) {
        $self->{$item} = sub { };
    }

    my $node_content_cb = sub {
        my ( $scanner, $data_r, $node, @elements ) = @_;
        foreach my $item (@elements) { $scanner->scan_element( $data_r, $node, $item ) };
    };

        my $node_element_cb = sub {
            my ( $scanner, $data_r, $node, $element_name, $key, $next_node ) = @_;
            $scanner->scan_node( $data_r, $next_node );
        };

        my $hash_element_cb = sub {
            my ( $scanner, $data_r, $node, $element_name, @keys ) = @_;
            foreach my $item (@keys) { $scanner->scan_hash( $data_r, $node, $element_name, $item ) };
        };

        $self->{list_element_cb} = $hash_element_cb;
        $self->{hash_element_cb} = $hash_element_cb;
        $self->{node_element_cb} = $node_element_cb;
        $self->{node_content_cb} = $node_content_cb;
        $self->{up_cb}           = sub { };            # do nothing

    my $l = $self->{string_value_cb} ||= $self->{leaf_cb};

        foreach my $cb (@value_cb, "check_list_element_cb") {
            $self->{$cb} ||= $l;
    }

    return;
}

sub scan_node {
    my ( $self, $data_r, $node ) = @_;

    #print "scan_node ",$node->name,"\n";
    # get all elements according to catalog

    Config::Model::Exception::Internal->throw( error => "'$node' is not a Config::Model object" )
        unless blessed($node)
        and $node->isa("Config::Model::AnyThing");

    # skip exploration of warped out node
    if ( $node->isa('Config::Model::WarpedNode') ) {
        $node = $node->get_actual_node;
        return unless defined $node;
    }

    my $config_class     = $node->config_class_name;
    my $node_dispatch_cb = $self->{node_dispatch_cb}{$config_class};

    my $actual_cb = $node_dispatch_cb || $self->{node_content_cb};

    my @element_list = $node->get_element_name( check => $self->{check} );

    $self->{node_content_hook}->( $self, $data_r, $node, @element_list );

    # we could add here a "last element" call-back, but it's not

lib/Config/Model/ObjTreeScanner.pm  view on Meta::CPAN

=item *

For each item contained in a node, hash or list. This item can be a
leaf or another node.

=back

To continue the exploration, these call-backs must also call the
scanner. (i.e. perform another call-back). In other words the user's
subroutine and the scanner play a game of ping-pong until the tree is
completely explored.

Hooks routines are not required to resume the exploration, i.e. to call
the scanner. This is done once the hook routine has returned.

The scanner provides a set of default callback for the nodes. This
way, the user only have to provide call-backs for the leaves.

The scan is started with a call to C<scan_node>. The first parameter
of scan_node is a ref that is passed untouched to all call-back. This
ref may be used to store whatever result you want.

=head1 CONSTRUCTOR

=head2 new

One way or another, the ObjTreeScanner object must be able to find all
callback for all the items of the tree. All the possible call-back and
hooks are listed below:

=over

=item leaf callback:

C<leaf_cb> is a catch-all generic callback. All other are specialized
call-back : C<enum_value_cb>, C<integer_value_cb>, C<number_value_cb>,
C<boolean_value_cb>, C<string_value_cb>, C<uniline_value_cb>,
C<reference_value_cb>, C<file_value_cb>, C<dir_value_cb>

=item node callback:

C<node_content_cb> , C<node_dispatch_cb>

=item node hooks:

C<node_content_hook>

=item element callback:

All these call-backs are called on the elements of a node:
C<list_element_cb>, C<check_list_element_cb>, C<hash_element_cb>,
C<node_element_cb>, C<node_content_cb>.

=item element hooks:

C<list_element_hook>, C<hash_element_hook>.

=back

The user may specify callbacks them by passing a sub ref to the
constructor:

   $scan = Config::Model::ObjTreeScanner-> new
  (
   list_element_cb => sub { ... },
   ...
  )

C<leaf_cb> callback is mandatory. Other callbacks are provided by default.

Optional parameter:

=over

=item fallback

Deprecated with version 2.159. This parameter is now ignored and
default callbacks are always provided.

=item auto_vivify

Whether to create configuration objects while scanning (default is 1).

=item check

C<yes>, C<no> or C<skip>.

=back

=head1 Callback prototypes

=head2 Leaf callback

C<leaf_cb> is called for each leaf of the tree. The leaf callback is
called with the following parameters:

 ($scanner, $data_ref,$node,$element_name,$index, $leaf_object)

where:

=over

=item *

C<$scanner> is the scanner object.

=item *

C<$data_ref> is a reference that is first passed to the first call of
the scanner. Then C<$data_ref> is relayed through the various
call-backs

=item *

C<$node> is the node that contain the leaf.

=item *

C<$element_name> is the element (or attribute) that contain the leaf.

=item *

C<$index> is the index (or hash key) used to get the leaf. This may
be undefined if the element type is scalar.

=item *

C<$leaf_object> is a L<Config::Model::Value> object.

=back

=head2 List element callback

C<list_element_cb> is called on all list element of a node, i.e. call
on the list object itself and not in the elements contained in the
list.

 ($scanner, $data_ref,$node,$element_name,@indexes)