mobundle

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Carp;
   5 use Pod::Usage qw( pod2usage );
   6 use Getopt::Long qw( :config gnu_getopt );
   7 use English qw( -no_match_vars );
   8 use File::Slurp ();
   9 use Template::Perlish;
  10 use Path::Class qw( foreign_file dir );
  11 use File::Basename qw( basename );
  12 my $VERSION = '0.1.0';
  13
  14 # Integrated logging facility
  15 #  use Log::Log4perl qw( :easy :no_extra_logdie_message );
  16 #  Log::Log4perl->easy_init({level=>$INFO, layout=>'[%d %-5p] %m%n'});
  17
  18 my %config = (output => '-', 'modules-from' => [], include => []);
  19 GetOptions(
  20    \%config,
  21    qw(
  22      usage help man version
  23      autoscan|scan|a!
  24      autoscan-list|scan-list|modules-list|l!
  25      body|b=s
  26      body-from|script|program|B=s
  27      head|h=s
  28      head-from|H=s
  29      head-from-body|S:i
  30      head-from-paragraph|P!
  31      include|I=s@
  32      modules|module|m=s@
  33      modules-from|M=s@
  34      output|o=s
  35      standard-head|s!
  36      )
  37 );
  38 pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
  39   if $config{version};
  40 pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
  41 pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
  42   if $config{help};
  43 pod2usage(-verbose => 2) if $config{man};
  44
  45 # Various checks for input parameter consistence and overriding
  46 pod2usage(
  47    message   => "head and standard-head are mutually exclusive",
  48    -verbose  => 99,
  49    -sections => ''
  50 ) if exists($config{head}) && exists($config{'standard-head'});
  51 $config{head} = "#!/usr/bin/env perl\n"
  52   if exists $config{'standard-head'};
  53
  54 pod2usage(
  55    message   => "(standard-)head and head-from are mutually exclusive",
  56    -verbose  => 99,
  57    -sections => ''
  58 ) if exists($config{head}) && exists($config{'head-from'});
  59 $config{head} = read_file($config{'head-from'})
  60   if exists $config{'head-from'};
  61
  62 # Get body
  63 if (@ARGV) {
  64    pod2usage(
  65       message   => "body and bare parameter are mutually exclusive",
  66       -verbose  => 99,
  67       -sections => ''
  68    ) if exists $config{body};
  69    pod2usage(
  70       message   => "body-from and bare parameter are mutually exclusive",
  71       -verbose  => 99,
  72       -sections => ''
  73    ) if exists($config{'body-from'});
  74    pod2usage(
  75       message   => "only one bare command line parameter is allowed",
  76       -verbose  => 99,
  77       -sections => ''
  78    ) if @ARGV > 1;
  79    $config{'body-from'} = shift @ARGV;
  80 }
  81 if (exists $config{'body-from'}) {
  82    pod2usage(
  83       message   => "body and body-from are mutually exclusive",
  84       -verbose  => 99,
  85       -sections => ''
  86    ) if exists $config{body};
  87    $config{body} = read_file($config{'body-from'})
  88 }
  89 pod2usage(
  90    message   => "one between body, body-from or bare parameter is needed",
  91    -verbose  => 99,
  92    -sections => ''
  93 ) unless exists $config{body};
  94
  95
  96 if (exists $config{'head-from-body'}) {
  97    pod2usage(
  98       message   => "multiple head sources are not allowed",
  99       -verbose  => 99,
 100       -sections => ''
 101    ) if exists($config{head});
 102
 103    my @body = split /\n/, $config{body};
 104    my @header = splice @body, 0, $config{'head-from-body'} || 1;
 105
 106    $config{head} = join "\n", @header;
 107    $config{body} = join "\n", @body;
 108 } ## end if (exists $config{'head-from-body'...
 109
 110 if (exists $config{'head-from-paragraph'}) {
 111    pod2usage(
 112       message   => "multiple head sources are not allowed",
 113       -verbose  => 99,
 114       -sections => ''
 115    ) if exists($config{head});
 116
 117    ($config{head}, $config{body}) = split /\n\s*?\n/, $config{body}, 2;
 118 }
 119
 120 push @INC, @{$config{include}};
 121
 122 for my $file (@{$config{'modules-from'}}) {
 123    chomp(my @modules = read_file($file));
 124    push @{$config{modules}}, @modules;
 125 }
 126
 127 # Load files for explicitly requested modules
 128 my %modules = map {
 129    (my $filename = $_) =~ s{::}{/}g;
 130    $filename .= '.pm' unless $filename =~ /\./mxs;
 131    $filename => get_module_contents($filename);
 132 } @{$config{modules}};
 133
 134 # Now autoscan if requested. Already-loaded modules will be skipped
 135 if ($config{autoscan} || $config{'autoscan-list'}) {
 136    require Module::ScanDeps;
 137    require File::Temp;
 138    require Config;
 139
 140    my $fh = File::Temp->new(UNLINK => 1, SUFFIX => '.pl');
 141    binmode $fh;
 142    print {$fh} $config{body};
 143    $fh->close();
 144
 145    my @filenames = $fh->filename();
 146    my %flag_for;
 147    while (@filenames) {
 148       my $filename = shift @filenames;
 149       next if $flag_for{$filename}++;
 150       my $deps_for =
 151         Module::ScanDeps::scan_deps(files => [$filename], skip => {%modules});
 152
 153       my $priv = dir($Config::Config{privlib});
 154       my $arch = dir($Config::Config{archlib});
 155       while (my ($key, $mod) = each %$deps_for) {
 156          next if exists $modules{$key};
 157
 158          # Restrict to modules...
 159          next unless $mod->{type} eq 'module';
 160
 161          my $privPath = $priv->file($key)->as_foreign('Unix');
 162          my $archPath = $arch->file($key)->as_foreign('Unix');
 163          next if $mod->{file} eq $privPath || $mod->{file} eq $archPath;
 164
 165          $modules{$key} = read_file($mod->{file});
 166          push @filenames, $mod->{file};
 167       } ## end while (my ($key, $mod) = ...
 168    }
 169
 170    if ($config{'autoscan-list'}) {
 171       for my $path (sort keys %modules) {
 172          (my $name = $path) =~ s/\.pm$//;
 173          $name =~ s{/}{::}g;
 174          print "$name\n";
 175       }
 176       exit 0;
 177    }
 178 } ## end if ($config{autoscan})
 179
 180 $config{modules} = \%modules;
 181
 182 my $template = <<'END_OF_TEMPLATE';
 183 [% head %]
 184
 185 # __MOBUNDLE_INCLUSION__
 186 BEGIN {
 187    my %file_for = (
 188 [% while (my ($filename, $contents) = each %{$variables{modules}}) { %]
 189       '[%= $filename %]' => <<'END_OF_FILE',
 190 [%= $contents =~ s/^/ /gmxs; $contents; %]
 191 END_OF_FILE
 192 [% } %]
 193    );
 194
 195    unshift @INC, sub {
 196       my ($me, $packfile) = @_;
 197       return unless exists $file_for{$packfile};
 198       (my $text = $file_for{$packfile}) =~ s/^\ //gmxs;
 199       chop($text); # added \n at the end
 200       open my $fh, '<', \$text or die "open(): $!\n";
 201       return $fh;
 202    };
 203 } ## end BEGIN
 204 # __MOBUNDLE_INCLUSION__
 205
 206 [% body %]
 207 END_OF_TEMPLATE
 208
 209 write_file($config{output},
 210    Template::Perlish->new()->process($template, \%config));
 211
 212 sub read_file {
 213    File::Slurp::read_file $_[0] eq '-' ? \*STDIN : $_[0];
 214 }
 215
 216 sub write_file {
 217    my $f = shift;
 218    File::Slurp::write_file(($f eq '-' ? \*STDOUT : $f), @_);
 219 }
 220
 221 sub get_module_contents {
 222    my ($filename) = @_;
 223    for my $item (@INC) {
 224       my $full_path =
 225         foreign_file('Unix', $item . '/' . $filename)->stringify();
 226       next unless -e $full_path;
 227       return scalar read_file $full_path;
 228    } ## end for my $item (@INC)
 229    carp "could not find module file: '$filename'";
 230 } ## end sub get_module_contents
 231
 232 __END__
 233
 234 =head1 NAME
 235
 236 mobundle - bundle modules inside your scripts
 237
 238 =head1 VERSION
 239
 240 Ask the version number to the script itself, calling:
 241
 242    shell$ mobundle --version
 243
 244 =head1 USAGE
 245
 246    mobundle [--usage] [--help] [--man] [--version]
 247
 248    mobundle [--autoscan|--scan|-a]
 249             [--autoscan-list|--scan-list|--modules-list|-l]
 250             [--body|-b <body>]
 251             [--body-from|--script|--program|-B <filename>]
 252             [--head|-h <head>] [--head-from|-H <filename>]
 253             [--head-from-body|-S <n>]
 254             [--head-from-paragraph|-P]
 255             [--include|-I <dirname>]
 256             [--module|-m <name>]
 257             [--modules-from|-M <filename>]
 258             [--output|-o <filename>]
 259             [--standard-head|-s]
 260
 261 =head1 EXAMPLES
 262
 263    shell$ mobundle -m Template::Perlish yourscript.pl
 264
 265    shell$ mobundle -m Template::Perlish --head '#!/path/to/perl' script.pl
 266
 267    shell$ mobundle -m Acme::Laugh --head-from-paragraph laugh.pl
 268
 269    # This lists all the modules that mobundle would include with
 270    # --autoscan|--scan|-a. Save it, trim it and you're done!
 271    shell$ mobundle --autoscan-list laugh.pl
 272
 273    # If you want to bundle some module that is local to your project
 274    shell$ mobundle -I ./lib -m My::Module ./bin/script.pl
 275
 276 =head1 DESCRIPTION
 277
 278 C<mobundle> lets you bundle Perl modules inside your Perl script, in order
 279 to ship a single script instead of N separate files.
 280
 281 The underlying logic is simple: all modules are included in the generated
 282 script, and the module loading mechanism is tweaked in order to let you
 283 load the bundled modules. See the documentation for L<perlfunc/require>
 284 to understand how.
 285
 286 The generated script will be compound of three main parts: a C<head>,
 287 a section with the bundled modules and the logic to load them, and
 288 a C<body>. Briefly speaking:
 289
 290 =over
 291
 292 =item B<head>
 293
 294 this is where you should put your shabang and the C<use>s that you would
 295 like to happen before the module loading mechanism is tweaked.
 296
 297 The C<head> is guaranteed to start at the very first octet in the result,
 298 so you can put a shabang.
 299
 300 =item B<modules>
 301
 302 this part is generated automatically based on your instructions about which
 303 modules should be bundled.
 304
 305 =item B<body>
 306
 307 this is the body of your script, i.e. what your script is supposed to do.
 308 It will likely contain either C<use>s or C<require>s that need the modules
 309 that are bundled in the C<modules> section.
 310
 311 =back
 312
 313 =head2 Why Another? Use PAR!
 314
 315 L<PAR> is fantastic: lets you bundle all the needed components of your
 316 application inside a single executable, and ship it. But... there's a
 317 niche that it's not able to cover, at least looking at the documentation.
 318
 319 In particular, there seem to be two different operation modes, depending
 320 on your needs
 321
 322 =over
 323
 324 =item *
 325
 326 either you're willing to bundle the interpreter as well, in which case
 327 L<PAR> (or, better, L<pp>) will generate a super-executable bundling all
 328 necessary stuff
 329
 330 =item *
 331
 332 or you have to be sure that L<PAR> is installed in the target directory.
 333
 334 =back
 335
 336 My need was somewhere in between: on the one side I wasn't willing to bundle
 337 the interpreter, on the other I couldn't ensure that L<PAR> was available.
 338
 339 In particular, this kind of need arises every time that my programs only need
 340 Pure-Perl modules, that do not need any platform-specific installation
 341 process. In this case, bundling the interpreter means restricting the
 342 applicability to one (or more, at some cost) platform only; the other way
 343 is simply not acceptable in some environments.
 344
 345
 346 =head1 OPTIONS
 347
 348 =over
 349
 350 =item --autoscan | -scan | -a
 351
 352 tries to use L<Module::ScanDeps> to find non-core modules that might be
 353 needed. Note that this is not PAR, so you should be careful of what is
 354 taken in.
 355
 356 For example, L<Archive::Tar> can operate without L<IO::Zlib>, but
 357 L<Module::ScanDeps> will bring it in together with a lot of stuff.
 358
 359 =item --body | -b <body>
 360
 361 turn your one-liner in a self contained script! Just pass the C<body> of your
 362 script and you're done.
 363
 364 =item --body-from | -B <filename>
 365
 366 get the body of the target script from the given filename.
 367
 368 =item --head | -h <head>
 369
 370 the C<head> is the part that will be put at the very beginning of the
 371 resulting script. Can be useful to specify a shabang.
 372
 373 =item --head-from | -H <filename>
 374
 375 get the C<head> from the given filename. See L</head>.
 376
 377 =item --head-from-body | -S <n>
 378
 379 get the C<head> taking it from the first C<n> lines of the body. See
 380 L</head> and L</body>.
 381
 382 =item --head-from-paragraph | -P
 383
 384 get the C<head> from the very first paragraph in the C<body>. See
 385 L</head> and L</body>.
 386
 387 =item --help
 388
 389 print a somewhat more verbose help, showing usage, this description of
 390 the options and some examples from the synopsis.
 391
 392 =item --include | -I <dirname>
 393
 394 add C<dirname> to @INC, which is also the directory used to look for
 395 modules' sources.
 396
 397 =item --man
 398
 399 print out the full documentation for the script.
 400
 401 =item --module | -m <name>
 402
 403 include the given module in the final script. You can specify this option
 404 multiple times for multiple modules.
 405
 406 When used with L</--autoscan>, these modules are skipped during the scan.
 407
 408 =item --modules-from | -M <filename>
 409
 410 get a list of modules to bundle from the given filename.
 411
 412 =item --autoscan-list | --scan-list | --modules-list | -l
 413
 414 print out the list of modules that would be included by L</--autoscan>.
 415
 416 =item --usage
 417
 418 print a concise usage line and exit. You can specify this option
 419 multiple times for multiple modules.
 420
 421 When used with L</--autoscan>, these modules are skipped during the scan.
 422
 423 =item --output | -o <filename>
 424
 425 set a filename for output, instead of standard output. When C<-> is given,
 426 standard output is assumed.
 427
 428 =item --standard-head | -s
 429
 430 put a standard header at the beginning of the generated script, i.e.:
 431
 432    #!/usr/bin/env perl
 433
 434 =item --version
 435
 436 print the version of the script.
 437
 438 =back
 439
 440 =head1 CONFIGURATION AND ENVIRONMENT
 441
 442 mobundle requires no configuration files or environment variables.
 443
 444 =head1 DEPENDENCIES
 445
 446 Non-core modules needed:
 447
 448 =over
 449
 450 =item B<< File::Slurp >>
 451
 452 =item B<< Template::Perlish >>
 453
 454 =item B<< Path::Class >>
 455
 456 =item B<< Module::ScanDeps >>
 457
 458 but only if you want to use the L</--autoscan> option.
 459
 460 =back
 461
 462 Did you say that I should I<bundle> them?!?
 463
 464 =head1 BUGS AND LIMITATIONS
 465
 466 No bugs have been reported.
 467
 468 Please report any bugs or feature requests through http://rt.cpan.org/
 469
 470 Undoubtfully there are many bugs, and more limitations.
 471
 472 =head1 AUTHOR
 473
 474 Flavio Poletti C<polettix@cpan.org>
 475
 476 =head1 COPYRIGHT AND LICENSE
 477
 478 Copyright (c) 2008-2011 by Flavio Poletti C<polettix@cpan.org>.
 479
 480 This program is free software. You can redistribute it and/or
 481 modify it under the terms of the Artistic License 2.0.
 482
 483 This program is distributed in the hope that it will be useful,
 484 but without any warranty; without even the implied warranty of
 485 merchantability or fitness for a particular purpose.
 486
 487 =cut