File Coverage

blib/lib/Data/Hopen.pm

Criterion	Covered	Total	%
statement	64	64	100.0
branch	24	24	100.0
condition	2	2	100.0
subroutine	18	18	100.0
pod	6	6	100.0
total	114	114	100.0

#!perl
# lib/Data/Hopen.pm: utility routines for hopen(1).  This file is also the
# source of the repo's README.md, which is autogenerated from this POD.

package Data::Hopen;
use strict;
use Data::Hopen::Base;

use parent 'Exporter';

# TODO move more of these to a separate utility package?
# Probably keep hnew, hlog, $VERBOSE, and $QUIET here.
use vars::i {
    '@EXPORT' => [qw(hnew hlog getparameters)],
    '@EXPORT_OK' => [qw(loadfrom *VERBOSE *QUIET UNSPECIFIED NOTHING)],
};                              #^ * => can be localized
use vars::i '%EXPORT_TAGS' => {
    default => [@EXPORT],
    v => [qw(*VERBOSE *QUIET)],
    all => [@EXPORT, @EXPORT_OK],
};

use Data::Hopen::Util::NameSet;
use Getargs::Mixed;
use Storable ();

our $VERSION = '0.000017';

# Docs {{{1

=head1 NAME

Data::Hopen - A dataflow library with first-class edges

=head1 SYNOPSIS

C is a dataflow library that runs actions you specify, moves data
between those actions, and permits transforming data as the data moves.  It is
the underlying engine of the L cross-platform software build
generator, but can be used for any dataflow task that can be represented as a
directed acyclic graph (DAG).

=head1 INSTALLATION

Easiest: install C if you don't have it - see
L.  Then run
C.

Manually: clone or untar into a working directory.  Then, in that directory,

    perl Makefile.PL
    make
    make test

(you may need to install dependencies as well -
see L for resources).
If all the tests pass,

    make install

If some of the tests fail, please check the issues and file a new one if
no one else has reported the problem yet.

=head1 VARIABLES

Not exported by default, except as noted.

=head2 $VERBOSE

Set to a positive integer to get debug output on stderr from hopen's internals.
The higher the value, the more output you are likely to get.  See also L.

=head2 $QUIET

Set to truthy to suppress output.  Quiet overrides L.

=cut

# }}}1

our $VERBOSE;   BEGIN { $VERBOSE = 0; }
our $QUIET;     BEGIN { $QUIET = false; }

=head1 FUNCTIONS

All are exported by default unless indicated.

=head2 hnew

Creates a new Data::Hopen instance.  For example:

    hnew DAG => 'foo';

is the same as

    Data::Hopen::G::DAG->new( name => 'foo' );

The first parameter (C<$class>) is an abbreviated package name.  It is tried
as the following, in order.  The first one that succeeds is used.

=over

=item 1.

C.  This is tried only if C<$class>
does not include a double-colon.

=item 2.

C

=item 3.

C<$class>

=back

The second parameter
must be the name of the new instance.  All other parameters are passed
unchanged to the relevant constructor.

=cut

sub hnew {
    my $class = shift or croak 'Need a class';
    my @stems = ('Data::Hopen::G::', 'Data::Hopen::', '');
    shift @stems if $class =~ /::/;

    my $found_class = false;

    foreach my $stem (@stems) {
        eval "require $stem$class";
        next if $@;
        $found_class = "$stem$class";
        my $instance = "$found_class"->new('name', @_);
            # put 'name' in front of the name parameter.
        return $instance if $instance;
    }

    if($found_class) {
        croak "Could not create instance for $found_class";
    } else {
        croak "Could not find class for $class";
    }
} #hnew()

=head2 hlog

Log information if L is set.  Usage:

    hlog {  } [optional min verbosity level (default 1)];

The items in the list are joined by C<' '> on output, and a C<'\n'> is added.
Each line is prefixed with C<'# '> for the benefit of test runs.

The list is in C<{}> so that it won't be evaluated if logging is turned off.
It is a full block, so you can run arbitrary code to decide what to log.
If the block returns an empty list, hlog will not produce any output.
However, if the block returns at least one element, hlog will produce at
least a C<'# '>.

The message will be output only if L is at least the given minimum
verbosity level (1 by default).

If C<< $VERBOSE > 2 >>, the filename and line from which hlog was called
will also be printed.

=cut

sub hlog (&;$) {
    return if $QUIET;
    return unless $VERBOSE >= ($_[1] // 1);

    my @log = &{$_[0]}();
    return unless @log;

    chomp $log[$#log] if $log[$#log];
    # TODO add an option to number the lines of the output
    my $msg = (join(' ', @log)) =~ s/^/# /gmr;
    if($VERBOSE>2) {
        my ($package, $filename, $line) = caller;
        $msg .= " (at $filename:$line)";
    }
    say STDERR $msg;
} #hlog()

=head2 getparameters

An alias of the C function from L, but with
C<-undef_ok> set.

=cut

my $GM = Getargs::Mixed->new(-undef_ok => true);

sub getparameters {
    unshift @_, $GM;
    goto &Getargs::Mixed::parameters;
} #getparameters()

=head2 loadfrom

(Not exported by default) Load a package given a list of stems.  Usage:

    my $fullname = loadfrom($name[, @stems]);

Returns the full name of the loaded package, or falsy on failure.
If C<@stems> is omitted, no stem is used, i.e., C<$name> is tried as-is.

=cut

sub loadfrom {
    my $class = shift or croak 'Need a class';

    foreach my $stem (@_, '') {
        hlog { loadfrom => "$stem$class" } 3;
        eval "require $stem$class";
        if($@) {
            hlog { loadfrom => "$stem$class", 'load result was', $@ } 3;
        } else {
            return "$stem$class";
        }
    }

    return undef;
} #loadfrom()

=head1 CONSTANTS

=head2 UNSPECIFIED

A L that matches any non-empty string.
Always returns the same reference, so that it can be tested with C<==>.

=cut

my $_UNSPECIFIED = Data::Hopen::Util::NameSet->new(qr/.(*ACCEPT)/);
sub UNSPECIFIED () { $_UNSPECIFIED };

=head2 NOTHING

A L that never matches.  Always returns the
same reference, so that it can be tested with C<==>.

=cut

my $_NOTHING = Data::Hopen::Util::NameSet->new();
sub NOTHING () { $_NOTHING };

1; # End of Data::Hopen
__END__