File Coverage

blib/lib/Syntax/Collector.pm

Criterion	Covered	Total	%
statement	65	69	94.2
branch	18	30	60.0
condition	2	6	33.3
subroutine	13	13	100.0
pod			n/a
total	98	118	83.0

use 5.006001;
use strict;
use warnings;

use Exporter::Tiny qw//;
use Module::Runtime qw//;

{
	package Syntax::Collector;

	BEGIN {
		$Syntax::Collector::AUTHORITY = 'cpan:TOBYINK';
		$Syntax::Collector::VERSION   = '0.006';
	}

	sub import
	{
		my $class = shift;

		my %opts;
		my $opt = 'collect';
		while (my $arg = shift @_)
		{
			($arg =~ /^-(.+)$/)
				? ($opt = $1)
				: push(@{$opts{$opt}}, $arg)
		}

		Exporter::Tiny::_croak("Need to provide a list of use lines to collect")
			unless $opts{collect};
		$opts{collect} = [$opts{collect}] unless ref $opts{collect};

		my @features =
			map {
				m{^
					(use|no) \s+      # "use" or "no"
					(\S+) \s+         # module name
					([\d\._v]+)       # module version
					(?:               # everything else
						\s* (.+)
					)?                #    ... perhaps
					[;] \s*           # semicolon
				$}x
					? [$1, $2, $3, [ defined($4) ? eval "($4)" : ()] ]
					: Exporter::Tiny::_croak("Line q{$_} doesn't conform to 'use MODULE VERSION [ARGS];'")
			}
			grep { ! m/^#/ }                # not a comment
			grep { m/[A-Z0-9]/i }           # at least one alphanum
			map  { s/(^\s+)|(\s+$)//; $_ }  # trim
			map  { split /(\r?\n|\r)/ }     # split lines
			@{ $opts{collect} };

		no strict 'refs';
		no warnings 'closure';
		my $caller = caller;
		unshift @{"$caller\::ISA"}, 'Syntax::Collector::Collection';
		eval "package $caller; sub _syntax_collector_features { \@features }; 1"
			or Exporter::Tiny::_croak("$@");
		$INC{Module::Runtime::module_notional_filename($caller)} ||= (caller(0))[1];
	}
}

{
	package Syntax::Collector::Collection;

	BEGIN {
		$Syntax::Collector::Collection::AUTHORITY = 'cpan:TOBYINK';
		$Syntax::Collector::Collection::VERSION   = '0.006';
	}

	our @ISA = 'Exporter::Tiny';

	sub _exporter_validate_opts
	{
		my $class = shift;
		my ($opt) = @_;

		my $caller = $opt->{into};
		defined($caller) && !ref($caller)
			or Exporter::Tiny::_croak("Expected to be installing into a package!");

		$class->SUPER::_exporter_validate_opts(@_);

		my ($coderef_use, $coderef_no) = eval qq[
			package $caller;
			(
				sub { shift->import(\@_) },
				sub { shift->unimport(\@_) },
			)
		];

		foreach my $f ($class->_syntax_collector_features)
		{
			my ($use, $module, $version, $everything) = @$f;
			Module::Runtime::require_module($module);
			$module->VERSION($version) if $version;

			if (ref $opt->{$module} eq 'ARRAY')
				{ $everything = $opt->{$module} }
			elsif (ref $opt->{$module} eq 'HASH')
				{ $everything = [ %{$opt->{$module}} ] }
			elsif ($opt->{$module})
				{ next; }

			($module =~ /^Syntax::Feature::/)
				? $module->install(into => $caller, @$everything)
				: ($use eq 'no' ? $coderef_no : $coderef_use)->($module, @$everything)
		}

		if (my $afterlife = $class->can('IMPORT'))
		{
			eval qq[package $caller; \$afterlife->(\$opt)];
		}
	}

	sub modules
	{
		my $class = shift;

		my %modules = map { $_->[1] => $_->[2] } $class->_syntax_collector_features;
		return (wantarray ? keys(%modules) : \%modules);
	}
}

__FILE__
__END__