view release on metacpan or  search on metacpan

lib/App.pm  view on Meta::CPAN

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

=head1 Code Inclusion and Instrumentation

=cut

#############################################################################
# use()
#############################################################################

=head2 use()

    * Signature: App->use($class);
    * Param:  $class      string  [in]
    * Return: void
    * Throws: <none>
    * Since:  0.01

    Sample Usage: 

    App->use("App::Widget::Entity");

The use() method loads additional perl code and enables aspect-oriented
programming (AOP) features if they are appropriate.  If these did not
need to be turned on or off, it would be easier to simply use the
following.

  eval "use $class;"

The first AOP
feature planned is the printing of arguments on entry to a method and
the printing of arguments and return values on exit of a a method.

This is useful
for debugging and the generation of object-message traces to validate
or document the flow of messages through the system.

Detailed Conditions:

  * use(001) class does not exist: throw a App::Exception
  * use(002) class never used before: should succeed
  * use(003) class used before: should succeed
  * use(004) can use class after: should succeed

=cut

my (%used);

sub use {
    &App::sub_entry if ($App::trace);
    my ($self, $class) = @_;
    no strict;  # allow fiddling with the symbol table
    if (! defined $used{$class}) {
        # if we try to use() it again, we won't get an exception
        $used{$class} = 1;

        # I could look for a particular variable like $VERSION,
        # local (*VERSION) = ${*{"$class\::"}}{VERSION};
        # print "$class VERSION: ", ${*VERSION{SCALAR}}, "\n";

        # but I decided to look for *any* symbol table entry instead.
        if (%{*{"$class\::"}}) {  # if any symbols exist in the symbol table
            # do nothing
        }
        elsif ($class =~ /^([A-Za-z0-9_:]+)$/) {
            eval "use $1;";
            if ($@) {
                App::Exception->throw(
                    error => "class $class failed to load: $@\n",
                );
            }
        }
        else {
            App::Exception->throw(
                error => "Tried to load class [$class] with illegal characters\n",
            );
        }
    }
    &App::sub_exit() if ($App::trace);
}

# $dir = App->mkdir($prefix, "data", "app", "Context");
sub mkdir {
    &App::sub_entry if ($App::trace);
    my ($self, @dirs) = @_;

    my $dir = shift(@dirs);
    if ($dir) {
        mkdir($dir) if (! -d $dir);
        foreach my $d (@dirs) {
            $dir = File::Spec->catdir($dir, $d);
            mkdir($dir) if (! -d $dir);
        }
    }
    &App::sub_exit($dir) if ($App::trace);
    return($dir);
}

#############################################################################
# printargs()
#############################################################################

=head2 printargs()

    * Signature: App->printargs($depth, $skipatend, @args);
    * Param:     $depth       integer  [in]
    * Param:     $skipatend   integer  [in]
    * Param:     @args        any      [in]
    * Return:    void
    * Throws:    none
    * Since:     0.01

=cut

sub printargs {
    my $depth = shift;
    my $skipatend = shift;
    my ($narg);
    for ($narg = 0; $narg <= $#_ - $skipatend; $narg++) {
        print "," if ($narg);
        if (ref($_[$narg]) eq "") {