Acrux

 view release on metacpan or  search on metacpan

lib/Acme/Crux.pm  view on Meta::CPAN

    $app->debugmode;

Returns debug flag. 1 - on, 0 - off


=head2 elapsed

    my $elapsed = $app->elapsed;

    my $timing_begin = [gettimeofday];
    # ... long operations ...
    my $elapsed = $app->elapsed( $timing_begin );

Return fractional amount of time in seconds since unnamed timstamp has been created while start application

    my $elapsed = $app->elapsed;
    $app->log->debug("Database stuff took $elapsed seconds");

For formatted output:

    $app->log->debug(sprintf("%+.*f sec", 4, $app->elapsed));

=head2 error

    my $error = $app->error;

Returns error string if occurred any errors while working with application

    $app = $app->error( "error text" );

Sets new error message and returns object

=head2 exedir

    my $exedir = $app->exedir;

Gets exedir value

=head2 handlers

    my @names = $app->handlers;

Returns list of names of registered handlers

    my @names_and_aliases = $app->handlers(1);

Returns list of aliases and names of registered handlers

=head2 has_handler

    $app->has_handler($command)
        or die "The command not found";

This method returns true if the specified command name is exists

=head2 lookup_handler

    my $handler = $app->lookup_handler($name)
        or die "Handler not found";

Lookup handler by name or aliase. Returns handler or undef while error

=head2 option, opt, getopt

    my $value = $app->option("key");

Returns option value by key

    my $options = $app->option;

Returns hash-ref structure to all options

See L</options>

=head2 orig

    my $origin_args = $app->orig;

Returns hash-ref structure to all origin arguments

=head2 plugin

    $app->plugin(foo => 'MyApp::Plugin::Foo');
    $app->plugin(foo);
    $app->plugin(foo => 'MyApp::Plugin::Foo', {bar => 123, baz => 'test'});
    $app->plugin(foo => 'MyApp::Plugin::Foo', bar => 123, baz => 'test');
    $app->plugin(foo, undef, {bar => 123, baz => 'test'});

Load a plugin by name or pair - name and class

=head2 pwd

    my $pwd = $app->pwd;

This method returns current/working directory

=head2 register_handler

    use parent qw/Acme::Crux/;

    __PACKAGE__->register_handler(
        handler     => "foo",
        aliases     => "one, two",
        description => "Foo handler",
        params => {
            param1 => "test",
            param2 => 123,
        },
        code => sub {
    ### CODE:
        my $self = shift; # App
        my $meta = shift; # Meta data
        my @args = @_; # Arguments

        print Acrux::Util::dumper({
            meta => $meta,
            args => \@args,
        });

        return 1;
    });

Method for register new handler

Example output while running:

    $app->run('one', abc => 123, def => 456); # returns 1

    {
      "args" => ["abc", 123, "def", 456],
      "meta" => {
        "aliases" => ["one", "two"],
        "description" => "Foo handler",
        "name" => "foo",
        "params" => {
            "param1" => "test",
            "param2" => 123
        }
      },
      "name" => "foo"
    }

This method supports the following options:

=over 4

=item aliases, alias

lib/Acme/Crux.pm  view on Meta::CPAN

        return $self;
    }
    return $self->{lockdir};
}
sub webdir {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{webdir} = shift;
        return $self;
    }
    return $self->{webdir};
}
sub configfile {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{configfile} = shift;
        return $self;
    }
    return $self->{configfile};
}
sub logfile {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{logfile} = shift;
        return $self;
    }
    return $self->{logfile};
}
sub pidfile {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{pidfile} = shift;
        return $self;
    }
    return $self->{pidfile};
}

# Modes (methods)
sub testmode    { !! shift->{testmode} }
sub debugmode   { !! shift->{debugmode} }
sub verbosemode { !! shift->{verbosemode} }
sub silentmode  { ! shift->{verbosemode} }

# Methods
sub error {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{error} = shift;
        return $self;
    }
    return $self->{error};
}
sub begin {
    my $self = shift;
    $self->{hitime} = [gettimeofday];
    return $self->{hitime}
}
sub elapsed {
    my $self = shift;
    my $timing_begin = shift;
    return undef unless my $started = $timing_begin || $self->{hitime};
    return tv_interval($started, [gettimeofday]);
}
sub exedir { shift->{exedir} }
sub orig { shift->{orig} }
sub option {
    my $self = shift;
    my $key  = shift;
    my $opts = $self->{options};
    return undef unless $opts;
    return $opts unless defined $key;
    return $opts->{$key};
}
sub opt { goto &option }
sub getopt { goto &option }

# Register method. See Mojo::Util::monkey_patch
sub register_method {
    my $self = shift;
    my $code = pop || sub { 1 }; # last param
    my $method = pop;
    my $namespace = pop || ref($self) || $self || __PACKAGE__;
    croak qq{Can't register method: method name is missing} unless $method;
    croak qq{Can't register method "$method": subroutine code is not defined}
        unless is_code_ref($code);
    my $ent = sprintf("%s::%s", $namespace, $method);

    # Create new method
    no strict 'refs';
    no warnings 'redefine';
    *{$ent} = set_subname($ent, $code);

    ### Old version from CTK::Plugin::register_method
    ### Check
    ##return if do { no strict 'refs'; defined &{$ff} };
    ### Create method!
    ##do {
    ##    no strict 'refs';
    ##    *{$ff} = \&$callback;
    ##};

    return 1;
}

# Plugins
sub plugins {
    my $self = shift;
    return $self->{plugins} if scalar(@_) < 1;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $plugins = $self->{plugins};
    foreach my $k (keys %$args) {
        next if exists($plugins->{$k}) && $plugins->{$k}->{loaded}; # Skip loaded plugins
        $plugins->{$k} = { class => $args->{$k}, loaded => 0 } if length($args->{$k} // '');
    }
    return $self;
}
sub plugin {
    my $self = shift;
    my $name = shift // ''; # Plugin name
    my $class = shift // ''; # Plugin class
    my @args = @_;
    my $plugins = $self->{plugins}; # Get list of plugins
    return unless length $name;

    # Lookup class by name
    unless (length($class)) {
        # Lookup in existing plugins
        $class = $plugins->{$name}->{class} // '' if exists $plugins->{$name};

        # Lookup in defaults

lib/Acme/Crux.pm  view on Meta::CPAN

    $plugins->{$name} = {
        'class'     => $class,
        'loaded'    => 1,
        'time'      => time,
        'something' => $ret,
    };

    return $ret;
}

# Handlers
sub register_handler {
    my $class = shift;
       $class = ref($class) if ref($class);
    my %info = @_;
    my $k = "$class.$$";
    $Acme::Crux::Sandbox::HANDLERS{$k} = {} unless exists($Acme::Crux::Sandbox::HANDLERS{$k});
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{$k};

    # Handler name
    my $name = trim($info{handler} // $info{name} // 'default');
    croak("The handler name missing") unless length($name);
    delete $info{handler};
    $info{name} = $name;
    croak("The $name duplicate handler definition") if defined($handlers->{$name});

    # Handler aliases
    my $_aliases = $info{alias} // $info{aliases} // [];
       $_aliases = [ trim($_aliases) ] unless is_array_ref($_aliases);
    my $aliases = words(@$_aliases);
    #foreach my $al (@$_aliases) {
    #    next unless defined($al) && is_value($al);
    #    foreach my $p (split(/[\s;,]+/, $al)) {
    #        next unless defined($p) && length($p);
    #        $aliases{$p} = 1;
    #    }
    #}
    delete $info{alias};
    $info{aliases} = [grep {$_ ne $name} @$aliases];

    # Handler description
    $info{description} //= '';

    # Handler params
    my $params = $info{parameters} || $info{params} || {};
    delete $info{parameters};
    $params = {} unless is_hash_ref($params);
    $info{params} = $params;

    # Handler code
    my $code = $info{code} || sub {return 1};
    $info{code} = is_code_ref($code) ? $code : sub { $code };

    # Set info to handler data
    $handlers->{$name} = {%info};
    return 1;
}
sub lookup_handler {
    my $self = shift;
    my $name = trim(shift // '');
    return undef unless length $name;
    my $invocant = ref($self) || scalar(caller(0));
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
    return undef unless defined($handlers) && is_hash_ref($handlers);
    foreach my $n (keys %$handlers) {
        my $aliases = as_array_ref($handlers->{$n}->{aliases});
        return $handlers->{$n} if grep {defined && $_ eq $name} ($n, @$aliases);
    }
    return undef;
}
sub handlers {
    my $self = shift;
    my $all = shift // 0; # returns aliases too
    my $invocant = ref($self) || scalar(caller(0));
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
    return [] unless defined($handlers) && is_hash_ref($handlers);
    return [(sort {$a cmp $b} keys %$handlers)] unless $all;

    # All: names and aliases
    my %seen = ();
    foreach my $n (keys %$handlers) {
        my $aliases = as_array_ref($handlers->{$n}->{aliases});
        foreach my $_a ($n, @$aliases) {
            $seen{$_a} = 1 if defined($_a) and length($_a);
        }
    }
    return [(sort {$a cmp $b} keys %seen)];
}
sub has_handler {
    my $self = shift;
    my $name = trim(shift // '');
    return undef unless length $name;
    return !!grep { $_ eq $name } @{ $self->handlers(1) };
}
sub run_handler {
    my $self = shift;
    my $name = shift // 'default';
    my @args = @_;
    if ($self->{running}) {
        $self->error(sprintf(qq{The application "%s" is already runned}, $self->project));
        return 0;
    }
    unless(length($name)) {
        $self->error("Invalid handler name");
        return 0;
    }
    my $meta = $self->lookup_handler($name);
    unless ($meta) {
        $self->error(sprintf("Handler %s not found", $name));
        return 0;
    }

    # Run
    my %info = (orig => $name);
    my $func;
    $self->{running} = 1;
    foreach my $k (keys %$meta) {
        next unless defined $k;
        if ($k eq 'code') {
            $func = $meta->{code};
            next;
        }
        $info{$k} = $meta->{$k};
    }
    unless(is_code_ref($func)) {
        $self->error("Handler code not found! Maybe you need to implement it?");
        return 0;
    }

    # Call function and return
    my $ret = &$func($self, {%info}, @args);
    $self->{running} = 0;
    return $ret;
}
sub run { goto &run_handler }

# Internal functions (NOT METHODS)
sub _project2moniker {
    my $prj = shift;
    return unless defined($prj);
    $prj =~ s/::/-/g;
    $prj =~ s/[^A-Za-z0-9_\-.]/_/g; # Remove incorrect chars
    $prj =~ s/([_\-.]){2,}/$1/g; # Remove dubles
    return unless length($prj);
    return lc($prj);
}

1;

package Acme::Crux::Sandbox;

our %HANDLERS = ();