—package
Syntax::Collector;
use
5.008;
use
strict;
use
Carp;
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.