File Coverage

blib/lib/Petal/Utils.pm

Criterion	Covered	Total	%
statement	51	56	91.0
branch	14	20	70.0
condition	2	2	100.0
subroutine	11	12	91.6
pod	0	7	0.0
total	78	97	80.4

package Petal::Utils;

=head1 NAME

Petal::Utils - Useful template modifiers for Petal.

=head1 SYNOPSIS

  # install the default set of Petal modifiers:
  use Petal::Utils;

  # you can also install modifiers manually:
  Petal::Utils->install( 'some_modifier', ':some_set' );

  # see below for modifiers available & template syntax

=cut

use 5.006;
use strict;
use warnings::register;

use Petal::Hash;

our $VERSION = '0.06';
our $DEBUG   = 0;

#------------------------------------------------------------------------------
# Cusomized import() so the user can select different plugins & sets

# use an Exporter-like syntax here:
our %PLUGIN_SET =
  (
   ':none'    => [],
   ':all'     => [qw( :default :hash :debug )],
   ':default' => [qw( :text :date :logic :list :uri )],
   ':text'    => [qw( UpperCase LowerCase UC_First Substr Printf )],
   ':logic'   => [qw( And If Or Equal Like Decode )],
   ':date'    => [qw( Date US_Date )],
   ':list'    => [qw( Sort Limit Limitr)],
   ':hash'    => [qw( Each Keys )],
   ':uri'     => [qw( UriEscape Create_Href )],
   ':debug'   => [qw( Dump )],
  );

sub import {
    my $class = shift;
    push @_, ':default' unless @_;
    return $class->install( @_ );
}

sub install {
    my $class = shift;

    foreach my $item (@_) {
	next unless $item;
	if ($item =~ /\A:/) {
	    $class->install_plugin_set( $item );
	} else {
	    $class->install_plugin( $item );
	}
    }

    return $class;
}

sub install_plugin_set {
    my $class = shift;
    my $set   = shift;

    my $plugins = $PLUGIN_SET{$set}
      || die "Can't install non-existent plugin set '$set'!";

    # recursive so we can have sets of sets:
    $class->install( @$plugins );
}

sub install_plugins {
    my $class = shift;
    map { $class->install_plugin( $_ ) } @_;
    return $class;
}

sub install_plugin {
    my $class = shift;
    my $name  = shift;

    my $plugin = $class->find_plugin( $name );

    warn "installing Petal plugin: '$name'\n" if $DEBUG;

    if (UNIVERSAL::can($plugin, 'install')) {
	$plugin->install;
    } else {
	$Petal::Hash::MODIFIERS->{"$plugin:"} = $plugin;
    }

    return $class;
}

sub find_plugin {
    my $class  = shift;
    my $plugin = shift;

    return \&$plugin if $class->can( $plugin );

    if (my $plugin_class = $class->load_plugin( $plugin )) {
	return $plugin_class;
    }

    die "Can't find Petal plugin: '$plugin'!";
}

sub load_plugin {
    my $class  = shift;
    my $plugin = shift;

    my $plugin_class = $class->get_plugin_class_for( $plugin );
    return $plugin_class if $plugin_class->can( 'process' );

    eval "require $plugin_class";
    if ($@) {
	warnings::warn("error loading $plugin plugin: $@") if warnings::enabled;
	return;
    }

    return $plugin_class;
}

sub get_plugin_class_for {
    my $class  = shift;
    my $plugin = shift;
    my $plugin_class = "$class\::$plugin";
}


#------------------------------------------------------------------------------
# Plugins

## See Petal::Utils:: for plugin classes
## (plugins are now loaded as needed)

## Alternatively, use subs to insert new modifiers into the Petal Modifiers
## hash. Note that we do not get the $class value in this format.

# This style is deprecated:
# sub foo {
#    my $hash = shift;
#    my $args = shift;
#    my $result = $hash->fetch( $args );
#    return 'foo '.$result;
# }

1;

__END__