view release on metacpan or  search on metacpan

lib/App.pm  view on Meta::CPAN

        if ($debug_file eq "STDOUT") {
            $App::DEBUG_FILE = \*STDOUT;
        }
        elsif ($debug_file eq "STDERR") {
            $App::DEBUG_FILE = \*STDERR;
        }
        else {
            if ($debug_file !~ /^[>|]/) {
                $debug_file = "> $debug_file";
            }
            if (open(App::DEBUG_FILE_HANDLE, $debug_file)) {
                $App::DEBUG_FILE = \*App::DEBUG_FILE_HANDLE;
            }
            else {
                warn "WARNING: Couldn't open $debug_file: $!\n";
            }
        }
    }
    else {
        $App::DEBUG_FILE = \*STDOUT;
    }
    $App::DEBUG_FILE->autoflush(1);
}

#############################################################################
# SUPPORT FOR ASPECT-ORIENTED-PROGRAMMING (AOP)
#############################################################################

=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);