File Coverage

blib/lib/AxKit2/Plugin.pm

Criterion	Covered	Total	%
statement	24	105	22.8
branch	0	26	0.0
condition	0	11	0.0
subroutine	8	26	30.7
pod	7	10	70.0
total	39	178	21.9

# Copyright 2001-2006 The Apache Software Foundation
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#

# Base class for AxKit2 plugins

package AxKit2::Plugin;

use strict;
use warnings;

use AxKit2::Config;
use AxKit2::Constants;
use Attribute::Handlers;

# more or less in the order they will fire
# DON'T FORGET - edit "AVAILABLE HOOKS" below.
our @hooks = qw(
    logging connect pre_request post_read_request body_data uri_translation
    mime_map access_control authentication authorization fixup write_body_data
    xmlresponse response response_sent disconnect error
);
our %hooks = map { $_ => 1 } @hooks;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    bless ({}, $class);
}

sub register_hook {
    my ($self, $hook, $method, $unshift) = @_;

    $self->log(LOGDEBUG, "register_hook: $hook => $method");
    die $self->plugin_name . " : Invalid hook: $hook" unless $hooks{$hook};

    push @{$self->{__hooks}{$hook}}, sub {
        my $self = shift;
        local $self->{_hook} = $hook;
        local $self->{_client} = shift;
        local $self->{_config} = shift;
        $self->$method(@_);
    };
}

sub register_config {
    my ($self, $key, $store) = @_;

    AxKit2::Config->add_config_param($key, \&AxKit2::Config::TAKEMANY, $store);
}

our %validators;
sub Validate : ATTR(CODE) {
    my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
    $validators{$referent} = $data;
}

# default configuration handler
our $AUTOLOAD;
sub AUTOLOAD {
    die "Undefined subroutine &$AUTOLOAD called" unless $AUTOLOAD =~ m/::conf_[^:]*$/;
    shift;
    return @_;
}

sub _set_config {
    my ($self, $key, $config, @value) = @_;
    no strict 'refs';
    my $sub = "conf_$key";
    $self->{_config} = $config;
    @value = $self->$sub(@value) if $sub;
    delete $self->{_config};
    return if (!@value);
    $config->notes($self->plugin_name.'::'.$key,@value);
}

sub _register_config {
    my $self = shift;
    no strict 'refs';
    foreach my $key (keys %{*{ref($self)."::"}}) {
        next unless $key =~ m/^conf_/ && $self->can($key);
        my $sub = $self->can($key);
        my $validator = $validators{$sub} || \&AxKit2::Config::TAKEMANY;
        $validator = \&{"AxKit2::Config::$validator"} if (ref($validator) ne 'CODE');
        $key =~ s/^conf_//;
        AxKit2::Config->add_config_param($key, $validator, sub { $self->_set_config($key,@_) });
    }
}

sub _register {
    my $self = shift;
    $self->init();
    $self->_register_config();
    $self->_register_standard_hooks();
    $self->register();
}

sub init {
    # implement in plugin
}

sub register {
    # implement in plugin
}

sub config {
    my $self = shift;
    if (@_) {
        my $key = shift;
        return $self->{_config}->notes($self->plugin_name . "::$key", @_);
    }
    $self->{_config};
}

sub client {
    my $self = shift;
    $self->{_client} || "AxKit2::Client";
}

sub log {
    my $self = shift;
    my $level = shift;
    my ($package) = caller;
    if ($package eq __PACKAGE__ || !defined $self->{_hook}) {
        $self->client->log($level, $self->plugin_name, " ", @_);
    }
    else {
        $self->client->log($level, $self->plugin_name, " $self->{_hook} ", @_);
    }
}

sub _register_standard_hooks {
    my $self = shift;

    for my $hook (@hooks) {
        my $hooksub = "hook_$hook";
        $hooksub  =~ s/\W/_/g;
        $self->register_hook( $hook, $hooksub ) if ($self->can($hooksub));
    }
}

sub hooks {
    my $self = shift;
    my $hook = shift;

    return $self->{__hooks}{$hook} ? @{$self->{__hooks}{$hook}} : ();
}

sub _compile {
    my ($class, $plugin, $package, $file) = @_;

    my $sub;
    open F, $file or die "could not open $file: $!";
    {
      local $/ = undef;
      $sub = ;
    }
    close F;

    my $line = "\n#line 0 $file\n";

    my $eval = join(
                    "\n",
                    "package $package;",
                    'use AxKit2::Constants;',
                    'use AxKit2::Processor;',
                    'use base "AxKit2::Plugin";',
                    'use strict;',
                    "sub plugin_name { qq[$plugin] }",
                    'sub hook_name { return shift->{_hook}; }',
                    $line,
                    $sub,
                    "\n", # last line comment without newline?
                   );

    #warn "eval: $eval";

    $eval =~ m/(.*)/s;
    $eval = $1;

    eval $eval;
    die "eval $@" if $@;
}

1;

__END__