view release on metacpan or  search on metacpan

lib/App/Context.pm  view on Meta::CPAN

sub dbglevel {
    my ($self, $dbglevel) = @_;
    $App::DEBUG = $dbglevel if (defined $dbglevel);
    return $App::DEBUG;
}

#############################################################################
# debug_scope()
#############################################################################

=head2 debug_scope()

The debug_scope() method is used to get the hash which determines which
debug statements are to be printed out when the debug level is set to a
positive number.  It returns a hash reference.  If class names or
"class.method" names are defined in the hash, it will cause the
debug statements from those classes or methods to be printed.

    * Signature: $debug_scope = $context->debug_scope();
    * Param:     void
    * Return:    $debug_scope   {}
    * Throws:    App::Exception::Context
    * Since:     0.01

    Sample Usage: 

    $debug_scope = $context->debug_scope();
    $debug_scope->{"App::Context::CGI"} = 1;
    $debug_scope->{"App::Context::CGI.process_request"} = 1;

=cut

sub debug_scope {
    my $self = shift;
    my $debug_scope = $self->{debug_scope};
    if (!defined $debug_scope) {
        $debug_scope = {};
        $self->{debug_scope} = $debug_scope;
    }
    $debug_scope;
}

#############################################################################
# dump()
#############################################################################

=head2 dump()

    * Signature: $perl = $context->dump();
    * Param:     void
    * Return:    $perl      text
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage: 

    print $self->dump(), "\n";

=cut

use Data::Dumper;

sub dump {
    my ($self) = @_;
    my $d = Data::Dumper->new([ $self ], [ "context" ]);
    $d->Indent(1);
    return $d->Dump();
}

#############################################################################
# PROTECTED METHODS
#############################################################################

=head1 Protected Methods

These methods are considered protected because no class is ever supposed
to call them.  They may however be called by the context-specific drivers.

=cut

#############################################################################
# dispatch_events()
#############################################################################

=head2 dispatch_events()

    * Signature: $context->dispatch_events()
    * Param:     void
    * Return:    void
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage: 

    $context->dispatch_events();

The dispatch_events() method is called by the bootstrap environmental code
in order to get the Context object rolling.  It causes the program to block
(wait on I/O), loop, or poll, in order to find events from the environment
and dispatch them to the appropriate places within the App-Context framework.

It is considered "protected" because no classes should be calling it.

=cut

sub dispatch_events {
    &App::sub_entry if ($App::trace);
    my ($self, $max_events_occurred) = @_;

    $self->dispatch_events_begin();

    my $events = $self->{events};
    my ($event, $service, $name, $method, $args);
    my $results = "";
    my $show_current_session_object = 1;

    eval {
        while ($#$events > -1) {
            $event = shift(@$events);
            ($service, $name, $method, $args) = @$event;
            $results = $self->call($service, $name, $method, $args);
            $show_current_session_object = 0;
        }
        my ($type, $name);
        if ($show_current_session_object) {