File Coverage

blib/lib/Plugins/Style1.pm

Criterion	Covered	Total	%
statement	97	116	83.6
branch	35	62	56.4
condition	27	61	44.2
subroutine	12	15	80.0
pod	5	6	83.3
total	176	260	67.6

# Copyright (C) 2006, David Muir Sharnoff

package Plugins::Style1;

use strict;
use warnings;
use Plugins;
use Hash::Util qw(lock_keys);
use Carp;

our @ISA = qw(Plugins);

my $prefix_generator = "PREFIX_000000";
our $debug = 0;
our %sequence;
our $VERSION = $Plugins::VERSION;

sub new
{
	my ($pkg, %args) = @_;
	my $self = $pkg->SUPER::new(%args);
	my $context = $self->{context} || {};
	$self->{prefixes_done}		= $context->{prefixes_done} || {};
	$self->{parse_config_line}	= $args{parse_config_line};
	$self->{config_prefix}		= $context->{config_prefix};
	$self->{plugin_directories}	= $context->{plugin_directories} || [ '.' ];
	lock_keys(%$self)
		if $pkg eq __PACKAGE__;
	return $self;
}

sub parseconfig
{
	my ($self, $configfile, %args) = @_;

	my $caller = $args{self};

	$configfile ||= $args{configfile} || $args{context}{configfile} || $self->{configfile} || die "no config file";

	my $package = ref($caller) || scalar(caller());
	my $rdebug = $debug;
	{
		no strict qw(refs);
		$rdebug = ${"${package}::debug"};
	}

	printf STDERR "Reading %s for %s\n", $configfile, scalar(caller()) if $rdebug;

	my $combined_prefix = '';

	my $prefix = first_defined(
		$args{config_prefix},
		$self->{config_prefix},
		($caller && $caller->can('config_prefix') && $caller->config_prefix()),
		($self->{context}{requestor} && $prefix_generator++),
		'');

	my %prefixes_done = %{$self->{prefixes_done}};
	$prefixes_done{$configfile}{$prefix} = ref($caller) ? ref($caller) : $caller;

	my $unknown = $args{parse_config_line}
		|| $self->{parse_config_line}
		|| ($caller && $caller->can('parse_config_line'))
		|| sub { die "unknown line in $configfile: '$_' (currently: shortname='$prefix', combined_prefix='$combined_prefix'" };

	my $plugin_directories = $args{plugin_directories} || $self->{plugin_directories};
	$plugin_directories = [ @$plugin_directories ];

	my %active_prefixes;
	my %known_prefixes;

	my $seqno = ++$sequence{$configfile};

	open(CONFIG, "<$configfile") or croak "Could not open config file $configfile: $!";
	while() {
		next if /^$/;
		next if /^#/;
		next if /^\s/;
		chomp;
		if (/^(.+_)?plugin\s+(\S+)(?:\s+as\s+(\w+)$)?/) {
			my $pre = $1;
			my $pkg = $2;
			my $config_prefix = $3;
			my @args;
			my $redo = 0;
			while () {
				$redo = 1;  # we haven't seen EOF
				chomp;
				last unless s/^\s+//;
				next if /^#/;
				while (s/(?:"(.*?)"|'(.*?)'|([^\s'"#][^\s#]*))\s*//) {
					my $word = defined($1) ? $1 : (defined $2 ? $2 : (defined $3 ? $3 : last));
					push(@args, $word);
					last if /^#/;
				}
			}
			if ($pkg =~ m{/} || $pkg =~ /^\w+$/) {
				$pkg = $self->file_plugin($pkg,
					search_path	=> $plugin_directories,
					referenced	=> "(referenced at $configfile line $.)",
				);
				$config_prefix ||= '';
			} elsif ($config_prefix) {
				$self->pkg_invoke($pkg);
			} else {
				$config_prefix = $self->pkg_invoke($pkg, 'config_prefix') || '';
			}
			if (! defined($pre) && $prefix eq '' or $pre && $prefix && $pre eq $prefix) {
				my $context = $self->registerplugin(
					pkg		=> $pkg,
					new_args	=> \@args,
					config_prefix	=> $config_prefix,
					configfile	=> $configfile,
					lineno		=> $.,
					seqno		=> $seqno,
					prefixes_done	=> \%prefixes_done,
					(ref($self) eq __PACKAGE__ ? () : (pkg_override => ref($self))),
					config_lines	=> [],
				);
				$prefixes_done{$configfile}{$config_prefix} = $prefixes_done{$configfile}{$prefix};
				$active_prefixes{$config_prefix} = $context;
				print STDERR "Plugin $pkg registered\n" if $rdebug;
			} else {
				# this isn't our plugin so we'll ignore it for now
				print STDERR "Plugin $pkg ignored\n" if $rdebug;
			}
			if ($config_prefix) {
				croak "config_prefix '$config_prefix' is used twice: first for at $configfile line $. and again at $known_prefixes{$config_prefix}"
					if $known_prefixes{$config_prefix};
				$known_prefixes{$config_prefix} = "$pkg at line $.";
				if ($combined_prefix) {
					$combined_prefix = qr/(?:$combined_prefix|\Q$config_prefix\E)/;
				} else {
					$combined_prefix = qr/\Q$config_prefix\E/;
				}
			}
			redo if $redo && $_;
		} elsif (/^plugin_directory\s+(\S.*)/) {
			push(@$plugin_directories, grep($_ && -d $_, split(' ', $1)));
		} elsif ($combined_prefix && /^($combined_prefix)/) {
			push(@{$active_prefixes{$1}{config_lines}}, {
				config_prefix	=> $1,
				configfile	=> $configfile,
				seqno		=> $seqno,
				lineno		=> $.,
				line		=> $_,
			}) if $active_prefixes{$1};
		} elsif ($prefix && $self->{prefixes_done} && $self->{prefixes_done}{$configfile}{''}) {
			if (/^$prefix/ && ! $self->{prefixes_done}{$configfile}{$prefix}) {
				s/((?:[^'"]|".*?"|'.*?')*#.*)/$1/;
				&$unknown($caller, $prefix, $configfile, $_, $., $seqno);
			}
		} else {
			s/((?:[^'"]|".*?"|'.*?')*#.*)/$1/;
			&$unknown($caller, $prefix, $configfile, $_, $.);
		}
	}
	return ();
}

sub genkey
{
	my ($self, $context) = @_;
	my $key = "$context->{pkg}/$context->{config_prefix}/$context->{configfile}";
	return $key;
}

sub post_initialize
{
	my ($self, $context, $plugin) = @_;
	for my $l (@{$context->{config_lines}}) {
		$plugin->invoke('parse_config_line', $l->{config_prefix}, $l->{configfile}, $l->{line}, $l->{lineno}, $l->{seqno});
	}
}

sub first_defined
{
	for my $i (@_) {
		return $i if defined $i;
	}
	return undef;
}

sub file_plugin
{
	my $self = shift;
	my $pkg = $self->SUPER::file_plugin(@_, isa => 'Plugins::Style1::Plugin');
	unless ($pkg->can('config_prefix')) {
		no strict 'refs';
		*{"${pkg}::config_prefix"} = sub { print STDERR "USING CONFIG_PREFIX\n"; ''; };
	}
	return $pkg;
}

package Plugins::Style1::Plugin;

our @ISA = qw(Plugins::Plugin);

1;