view release on metacpan or  search on metacpan

lib/App/MultiModule/Core.pm  view on Meta::CPAN

package App::MultiModule::Core;
$App::MultiModule::Core::VERSION = '1.171870';
use strict;use warnings;
use POE;
use Storable;
use IPC::Transit;

=head1 METHODS

=cut
{
my $tags = {};

sub _shutdown {
#http://poe.perl.org/?POE_FAQ/How_do_I_force_a_session_to_shut_down
    my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
    delete $heap->{wheel};
    $kernel->alias_remove($heap->{alias}) if $heap->{alias};
    $kernel->alarm_remove_all();
    $kernel->refcount_decrement($session, 'my ref name');
    $kernel->post($heap->{child_session}, 'shutdown') if $heap->{child_session};

    return;
}

=head2 named_recur(%args)

This is the preferred method to schedule recurring code in this framework.
Typically called from within set_config(), it automatically ensures
that only a single POE recurring event is setup, no matter how many times
named_recur() is called.

Simply put: if your tasks has code that needs to run on an interval,
use this method to schedule it.

The value in the 'recur_name' argument is used by this method to guard
against unwanted redundant scheduling of a code reference.

That is, for all calls to named_recur inside a process space, there
will be one and only one scheduled event per unique value of the
argument 'recur_name'.

This method takes all named arguments:

=over 4

=item recur_name (required) (process-globally unique string)

Process global unique identifier for a recurring POE event.

=item repeat_interval (required) (in seconds)

How often the work should repeat.

=item work (required) (CODE reference)

The Perl code that is run on an interval

=item tags (optional) (ARRAY reference of strings)

The list of tags associated with this recurring work. These are referenced
by del_recurs() to deallocate scheduled POE events.

=back

Example: (copied from lib/MultiModuleTest/Example1.pm in this distribution)

    $self->named_recur(
        recur_name => 'Example1',
        repeat_interval => 1, #runs every second
        work => sub {
            my $message = {
                ct => $self->{state}->{ct}++,
                outstr => $config->{outstr},
            };
            $self->emit($message);
        },
    }

=cut
sub named_recur {
    my $self = shift;
    my %args = @_;
    my $recur_name = $args{recur_name} || 'none';
    $App::MultiModule::Core::named_recur_times = {}
        unless $App::MultiModule::Core::named_recur_times;
    my $repeat_interval = $args{repeat_interval};
    if(     $self->{config} and

lib/App/MultiModule/Core.pm  view on Meta::CPAN

                        };
                        $repeat_interval = $r if $r;
#                        print STDERR "\$repeat_interval=$repeat_interval\n" if $r;
                    }
                    $_[KERNEL]->delay(tick => $repeat_interval);
                    &{$args{work}}(@_);
                },
            },
        },
        %args,
    );
}

=head2 add_session($session_def)

=cut
sub add_session {
    my $self = shift;
    my $session_def = shift;
    my %args = @_;
    my $my_tags = $args{tags} || [$self->{task_name}];
    die 'App::MultiModule::Core::add_sesion: passed argument "tags" must be an ARRAY reference'
        if not ref $my_tags or ref $my_tags ne 'ARRAY';
    push @{$my_tags}, $self->{task_name}
        unless grep { /^$self->{task_name}$/ } @$my_tags;
    $session_def->{inline_states}->{'shutdown'} = \&_shutdown;
    my $session_id = POE::Session->create(%$session_def);
    foreach my $tag (@{$my_tags}) {
        $tags->{$tag} = {} unless $tags->{$tag};
        $tags->{$tag}->{$session_id} = 1;
    }
}
}

{
my $get_info = sub {
    my $file = shift;
    my $has_message_method = 0;
    my $has_set_config_method = 0;
    my $is_stateful = 0;
    eval {
        open my $fh, '<', $file or die "failed to open $file: $!";
        while(my $line = <$fh>) {
            $has_message_method = 1 if $line =~ /^sub message/;
            $has_set_config_method = 1 if $line =~ /^sub set_config/;
            $is_stateful = 1 if $line =~ /^sub is_stateful/;
        }
        close $fh or die "failed to close $file: $!";
    };
    die "get_info: $@\n" if $@;
    my $is_multimodule = $has_message_method;
    return {
        is_stateful => $is_stateful,
        is_multimodule => $is_multimodule,
    };
};

=head2 get_multimodules_info

This returns a hash reference that contains information about every
task that the MultiModule framework is aware of.  'aware of' is not
limited to running and/or loaded.  A MultiModule task module that
exists in the configured search path, even though it is not referenced
or configured, will also be in this structure.

The key to the return hash is the task name.  The value is a reference
to a hash that contains a variety of fields:

=over 4

=item is_multimodule

Always true at this point; this is a legacy field that will be removed

=item is_stateful

Has a true value if the referenced task is stateful.

=item config

Contains undef if there is no config currently available for the task.
Otherwise, this field contains the config for the task.

=back

NOTE NOTE NOTE

At this time, calling this method from a task object will fail.  It can
only be called from the 'root', MultiModule object.

Example:
 while(my($task_name, $task_info) =
        each %{$root_object->get_multimodules_info}) {

 }

=cut
sub get_multimodules_info {
    my $self = shift;
    my %args = @_;
    my $module_prefixes = Storable::dclone($self->{module_prefixes});
    my $hits = {};
    foreach my $inc (@INC) {
        foreach my $prefix (@$module_prefixes) {
            $prefix =~ s/::/\//g;
            my $path = "$inc/$prefix";
            eval {  #ignore everything...
                die unless -d $path;
                opendir(my $dh, $path) or die "can't opendir $path: $!\n";
                foreach my $file (grep { not /^\./ and -f "$path/$_" and /\.pm$/ } readdir($dh)) {
                    my $info = $get_info->("$path/$file");
                    $file =~ s/\.pm$//;
                    if($info->{is_multimodule}) {
                        eval {
                            $info->{config} =
                                $self->{api}->get_task_config($file);
                        };
                        $hits->{$file} = $info;
                    }
                }
                closedir $dh;