use 5.008;
use Sub::Uplevel qw/uplevel :aggressive/;
use strict;
use syntax qw//; # deliberate dependency.
use Carp;
use Module::Runtime qw/require_module/;
use Sub::Name qw/subname/;
BEGIN {
$Syntax::Collector::AUTHORITY = 'cpan:TOBYINK';
$Syntax::Collector::VERSION = '0.002';
}
sub import
{
my $class = shift;
my %opts;
my $opt = 'collect';
while (my $arg = shift @_)
{
if ($arg =~ /^-(.+)$/)
{
$opt = $1;
}
else
{
$opts{$opt} = $arg;
}
}
croak "Need to provide a list of use lines to collect"
unless defined $opts{collect} and $opts{collect};
$opts{collect} = [$opts{collect}] unless ref $opts{collect};
my @collect =
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} };
my @features;
foreach my $use_line (@collect)
{
if ($use_line =~ m{^
(use|no) \s+ # "use" or "no"
(\S+) \s+ # module name
([\d\._v]+) # module version
(?:
\s* (.+) # everything else
)? # ... perhaps
[;] \s* # semicolon
$}x)
{
my ($use, $module, $version, $everything) = ($1, $2, $3, $4);
$everything = '' unless defined $everything;
if ($module =~ /^Syntax::Feature::/)
{
push @features, [FEATURE => $module, $version, [eval "($everything)"]]
unless $use eq 'no';
}
else
{
push @features, [MODULE => $module, $version, [eval "($everything)"], $use];
}
}
else
{
croak "Line q{$use_line} doesn't conform to 'use MODULE VERSION [ARGS];'";
}
}
my %sub;
$sub{import} = sub
{
my $self = shift;
my $caller = caller;
foreach my $f (@features)
{
my ($type, $module, $version, $everything, $use) = @$f;
if ($type eq 'FEATURE')
{
require_module($module);
$module->VERSION($version) if $version;
$module->install(into => $caller, @$everything);
}
else
{
require_module($module);
$module->VERSION($version) if $version;
my $coderef = $module->can($use eq 'no' ? 'unimport' : 'import');
uplevel 1, $coderef, $module, @$everything
if $coderef;
}
}
if (my $after = $self->can('IMPORT'))
{
@_ = ($self);
goto $after;
}
};
$sub{modules} = sub
{
my %modules =
map { $_->[1] => $_->[2] }
@features;
return (wantarray ? keys(%modules) : \%modules);
};
{
my $caller = caller;
foreach my $sub (sort keys %sub)
{
my $subname = sprintf("%s::%s", $caller, $sub);
no strict 'refs';
*{$subname} = subname $caller => $sub{$sub};
}
}
}
__FILE__
__END__
=head1 NAME
Syntax::Collector - collect a bundle of modules into one
=head1 SYNOPSIS
In lib/Example/ProjectX/Syntax.pm
package Example::ProjectX::Syntax;
use 5.010;
our $VERSION = 1;
use Syntax::Collector -collect => q/
use strict 0;
use warnings 0;
use feature 0 ':5.10';
use Syntax::Feature::Io 0;
use Syntax::Feature::Maybe 0;
use Syntax::Feature::Perform 0;
/;
__FILE__
__END__
In projectx.pl:
use Example::ProjectX::Syntax 1;
# strict, warnings, feature ':5.10', etc are now enabled!
use Example::ProjectX::Database;
say "Welcome to ProjectX";
=head1 DESCRIPTION
Perl is such a flexible language that the language itself can be extended
from within. (Though much of the more interesting stuff needs XS hooks like
L<Devel::Declare>.)
One problem with this is that it often requires a lot of declarations at the
top of your code, loading various syntax extensions. The L<syntax> module on
CPAN addresses this somewhat by allowing you to load a bunch of features in
one line, provided each syntax feature implements the necessary API:
use syntax qw/io maybe perform/;
However this introduces problems of its own. If we look at the code above,
it is non-obvious that it requires L<Syntax::Feature::Io>,
L<Syntax::Feature::Maybe> and L<Syntax::Feature::Perform>, which makes
it difficult for automated tools such as L<Module::Install> to automatically
calculate your code's dependencies.
Syntax::Collector to the rescue!
package Example::ProjectX::Syntax;
use 5.010;
use Syntax::Collector -collect => q/
use strict 0;
use warnings 0;
use feature 0 ':5.10';
use Syntax::Feature::Io 0;
use Syntax::Feature::Maybe 0;
use Syntax::Feature::Perform 0;
/;
When you C<use Syntax::Collector>, you provide a list of modules to
"collect" into a single package (notice the C<< q/.../ >>). This list
of modules looks like a big string of Perl code that is going to be
passed to C<eval>, but don't let that fool you - it is not.
Each line must conform to the following pattern:
(use|no) MODULENAME VERSION (OTHERSTUFF)? ;
(Actually hash comments, and blank lines are also allowed.) The semantics
of all that is pretty much what you'd expect, except that when MODULENAME
begins with "Syntax::Feature::" it's treated with some DWIMmery, and
C<install> is called instead of C<import>. Note that VERSION is required,
but if you don't care which version of a module you use, it's fine to
set VERSION to 0. (Yes, VERSION is even required for pragmata.)
Now, you ask... why stuff all that structured data into a string, and
parse it out again? Because to naive lexical analysis (e.g.
L<Module::Install>) it really looks like a bunch of "use" lines, and
not just a single quoted string. This helps tools calculate the
dependencies of your collection; and thus the dependencies of other
code that uses your collection.
Because Syntax::Collector provides an C<import> method for your collection
package, you cannot provide your own. However, the C<import> method
provided will automatically call a C<IMPORT> method if it exists. So you
can do this:
package Example::ProjectX::Syntax;
use 5.010;
our $VERSION = 1;
use constant {
PROJECT_NAME => 'Project X',
PROJECT_LEAD => 'Joe Bloggs',
};
BEGIN {
sub IMPORT {
no strict 'refs';
my $caller = caller;
*{"$caller\::PROJECT_NAME"} = \&PROJECT_NAME;
*{"$caller\::PROJECT_LEAD"} = \&PROJECT_LEAD;
*{"$caller\::add"} = \&add;
}
}
use Syntax::Collector -collect => q/
use strict 0;
use warnings 0;
use feature 0 ':5.10';
use Syntax::Feature::Io 0;
use Syntax::Feature::Maybe 0;
use Syntax::Feature::Perform 0;
/;
sub add {
my $x = shift;
return $x + add(@_);
}
__FILE__
__END__
As well as providing an C<import> method for your collection,
Syntax::Collector also provides a C<modules> method, which can be called
to find out which modules a collection includes. Called in list context,
it returns a list. Called in scalar context, it returns a reference to a
C<< { module => version } >> hash.
=head1 CAVEATS
This module does some pretty tricky stuff with L<Sub::Uplevel> and
C<eval>. It is possible that (especially in the case of convoluted
OVERSTUFF), certain "use" lines may break.
You should not rely on the "use" lines being processed in any
particular order.
=head2 Using with Exporter
It's a natural desire to want to use Syntax::Collector with Exporter. Because
both of these modules want to provide you with an C<import> method, you
need to resolve that manually:
package Example::ProjectX::Syntax;
use 5.010;
our $VERSION = 1;
use constant {
PROJECT_NAME => 'Project X',
PROJECT_LEAD => 'Joe Bloggs',
};
our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
BEGIN {
require qw/Exporter/;
@EXPORT = qw/ ... /;
@EXPORT_OK = qw/ ... /;
%EXPORT_TAGS = (
':standard' => \@EXPORT,
':all' => \@EXPORT_OK,
...);
sub IMPORT {
goto &Exporter::import;
}
}
use Syntax::Collector -collect => q/
use strict 0;
use warnings 0;
...
/;
1;
=head1 BUGS
Please report any bugs to
=head1 SEE ALSO
L<syntax>, L<Exporter>.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2012 by Toby Inkster.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 DISCLAIMER OF WARRANTIES
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.