view release on metacpan or  search on metacpan

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

service() method, the service cache in the Session is checked
first.  If it exists, it is generally returned immediately
without modification by the named parameters.
(Parameters *are* taken into account if the "override"
parameter is supplied.)

If it does not exist, it must be created and stored in the 
cache.

The name of a service, if not specified, is assumed to be "default".

The named parameters (%named or $named),
if supplied, are considered defaults.
They are ignored if the values already exist in the service conf.
However, the additional named parameter, "override", may be supplied.
In that case, all of the values in the named parameters will accepted
into the service conf.

Every service (i.e. $conf->{Repository}{default}) starts as
a simple hash which is populated with attributes from several
complementary sources.  If we imagine that a service is requested
with type $type and name $name, we can envision the following
additional derived variables.

  $type           = "Repository";
  $name           = "sysdb";
  $conf           = $context->conf();
  $repository_type = $conf->{Repository}{sysdb}{repository_type};

The following sources are consulted to populate the service
attributes.

  1. conf of the service (in Conf)
     i.e. $conf->{Repository}{sysdb}

  2. optional conf of the service's service_type (in Conf)
     i.e. $conf->{RepositoryType}{$repository_type}

  3. named parameters to the service() call

All service configuration happens before instantiation
this allows you to override the "service_class" in the configuration
in time for instantiation

=cut

sub service {
    &App::sub_entry if ($App::trace);
    my ($self, $type, $name, %named) = @_;
    $self->dbgprint("Context->service(" . join(", ",@_) . ")")
        if ($App::DEBUG && $self->dbg(3));
    my $options = $self->{options};

    my ($args, $new_service, $override, $lightweight, $attrib);
    my ($service, $conf, $class, $session);
    my ($service_store, $service_conf, $service_type, $service_type_conf);
    my ($default);

    # $type (i.e. SessionObject, Session, etc.) must be supplied
    if (!defined $type) {
        App::Exception->throw(
            error => "cannot create a service of unknown type\n",
        );
    }

    if (%named) {
        $args = \%named;
    }
    else {
        $args = {};
    }

    if (! defined $name || $name eq "") {    # we need a name!
        $name = "default";
    }

    $session = $self->{session};
    $service = $session->{cache}{$type}{$name};  # check the cache
    $conf = $self->{conf};
    $service_conf = $conf->{$type}{$name};
    my $temporary = ($name eq "temporary") || $args->{temporary};
    my $service_initialized = ($service && ref($service) ne "HASH");
    #print "$type($name): SERVICE=$service INIT=$service_initialized\n";

    ##############################################################
    # Load extra conf on demand
    ##############################################################
    if (!$service_initialized && !$service_conf && $name !~ /-/) {   # if it's not a contained widget, try the file system
        my $prefix = $options->{prefix};
        my $conf_type = $options->{conf_type} || "pl";
        my $conf_file = "$prefix/etc/app/$type.$name.$conf_type";
        if (!$self->{conf_included}{$conf_file} && -r $conf_file) {
            $options->{conf_file} = $conf_file;
            my $aux_conf = App::Conf::File->create({ %$options });
            $conf->overlay($aux_conf);
            $service_conf = $conf->{$type}{$name};
        }
        $self->{conf_included}{$conf_file} = 1;
    }

    ##############################################################
    # conf includes
    ##############################################################
    if (!$service_initialized && $service_conf && $service_conf->{include}) {
        my $prefix = $options->{prefix};
        my (@include_files);
        my $include_files = $service_conf->{include};
        if (ref($include_files) eq "ARRAY") {
            @include_files = @$include_files;
        }
        elsif (ref($include_files) eq "") {
            @include_files = ( $include_files );
        }
        foreach my $conf_file (@include_files) {
            $conf_file = "$prefix/etc/app/$conf_file" if ($conf_file !~ m!^/!);
            next if ($self->{conf_included}{$conf_file});
            if (-r $conf_file) {
                $options->{conf_file} = $conf_file;
                my $aux_conf = App::Conf::File->create({ %$options });
                $conf->overlay($aux_conf);
            }

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

    if (! defined $event{time}) {
        $event{time} = time();
        $event{time} += $event{interval} if ($event{interval});
    }

    my $unschedule = 0;
    if (defined $event{scheduled}) {
        $unschedule = ! $event{scheduled};
        delete $event{scheduled};
    }

    die "schedule_event(): (tag or method) is a required attribute of an event" if (!$event{tag} && !$event{method});
    $self->log({level=>3},"Schedule Event (" . join(",",%event) . ")\n");

    my $event;
    if ($event{tag}) {
        $event = $scheduled_event->{$event{tag}};
    }
    if ($event) {
        foreach my $key (keys %event) {
            $event->{$key} = $event{$key};
        }
    }
    else {
        $scheduled_event->{$event{tag}} = \%event if ($event{tag});
        $event = \%event;
    }

    if ($event->{scheduled}) {
        if ($unschedule && $event->{tag}) {
            # remove from list of scheduled events
            for (my $i = $#$scheduled_events; $i >= 0; $i--) {
                if ($scheduled_events->[$i]{tag} eq $event->{tag}) {
                    splice(@$scheduled_events, $i, 1); # remove the event
                    $event->{scheduled} = 0;
                    last;
                }
            }
        }
    }
    else {
        if (!$unschedule) {
            push(@$scheduled_events, $event);
            $event->{scheduled} = 1;
        }
    }

    &App::sub_exit() if ($App::trace);
}

sub get_current_events {
    &App::sub_entry if ($App::trace);
    my ($self, $events, $time) = @_;
    $time = time() if (!$time);
    my $time_of_next_event = 0;
    @$events = ();
    my $scheduled_event  = $self->{scheduled_event};
    my $scheduled_events = $self->{scheduled_events};
    my $verbose          = $self->{verbose};
    my ($event);
    # note: go in reverse order so that the splice() doesn't throw our indexes off
    # we do unshift() to keep events executing in FIFO order for a particular time
    for (my $i = $#$scheduled_events; $i >= 0; $i--) {
        $event = $scheduled_events->[$i];
        $self->log({level=>5},"Checking event: time=$time [$event->{time}, every $event->{interval}] $event->{method}().\n");
        if ($event->{time} <= $time) {
            unshift(@$events, $event);
            if ($event->{time} && $event->{interval}) {
                $event->{time} += $event->{interval}; # reschedule the event
                $self->log({level=>5},"Event Rescheduled: time=$time [$event->{time}, every $event->{interval}] $event->{method}().\n");
                if ($time_of_next_event == 0 || $event->{time} < $time_of_next_event) {
                    $time_of_next_event = $event->{time};
                }
            }
            else {
                $self->log({level=>5},"Event Removed: time=$time [$event->{time}, every $event->{interval}] $event->{method}().\n");
                splice(@$scheduled_events, $i, 1); # remove the (one-time) event
                $event->{scheduled} = 0;
            }
        }
        else {
            if ($time_of_next_event == 0 || $event->{time} < $time_of_next_event) {
                $time_of_next_event = $event->{time};
            }
        }
    }
    &App::sub_exit($time_of_next_event) if ($App::trace);
    return($time_of_next_event);
}

# NOTE: send_event() is similar to call(). I ought to resolve this.
sub send_event {
    &App::sub_entry if ($App::trace);
    my ($self, $event) = @_;
    my $method = $event->{method};
    my @args = $event->{args} ? @{$event->{args}} : ();
    my $name = $event->{name};
    my $service_type = $event->{service_type};
    $service_type = "SessionObject" if (!$service_type && $name);
    my (@results);
    if ($name) {
        my $service = $self->service($service_type, $name);
        $self->log({level=>3},"Send Event: $service_type($name).$method(@args)\n");
        @results = $service->$method(@args);
    }
    else {
        $self->log({level=>3},"Send Event: $method(@args)\n");
        @results = $self->$method(@args);
    }
    &App::sub_exit(@results) if ($App::trace);
    if (wantarray()) {
        return(@results);
    }
    else {
        if ($#results == -1) {
            return(undef);
        }
        elsif ($#results == 0) {
            return($results[0]);
        }
        else {