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::Basename qw( basename );
   9 my $VERSION = '0.1.2';
  10
  11 use File::Slurp ();
  12 use Template::Perlish;
  13 use Path::Class qw( foreign_file dir );
  14
  15 # Integrated logging facility
  16 #  use Log::Log4perl qw( :easy :no_extra_logdie_message );
  17 #  Log::Log4perl->easy_init({level=>$INFO, layout=>'[%d %-5p] %m%n'});
  18
  19 my %config = (output => '-', 'modules-from' => [], include => []);
  20 GetOptions(
  21    \%config,
  22    qw(
  23      usage help man version
  24      add-modules-list|L!
  25      autoscan|scan|a!
  26      autoscan-list|scan-list|modules-list|l!
  27      body|b=s
  28      body-from|script|program|B=s
  29      head|h=s
  30      head-from|H=s
  31      head-from-body|S:i
  32      head-from-paragraph|P!
  33      include|I=s@
  34      modules|module|m=s@
  35      modules-from|M=s@
  36      output|o=s
  37      standard-head|s!
  38      unbundle|u!
  39      )
  40 );
  41 pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
  42   if $config{version};
  43 pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
  44 pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
  45   if $config{help};
  46 pod2usage(-verbose => 2) if $config{man};
  47
  48 # Manage unbundle before all the rest
  49 if ($config{unbundle}) {
  50    unbundle(@ARGV);
  51    exit 0;
  52 }
  53
  54 # Various checks for input parameter consistence and overriding
  55 pod2usage(
  56    message   => "head and standard-head are mutually exclusive",
  57    -verbose  => 99,
  58    -sections => ''
  59 ) if exists($config{head}) && exists($config{'standard-head'});
  60 $config{head} = "#!/usr/bin/env perl\n"
  61   if exists $config{'standard-head'};
  62
  63 pod2usage(
  64    message   => "(standard-)head and head-from are mutually exclusive",
  65    -verbose  => 99,
  66    -sections => ''
  67 ) if exists($config{head}) && exists($config{'head-from'});
  68 $config{head} = read_file($config{'head-from'})
  69   if exists $config{'head-from'};
  70
  71 # Get body
  72 if (@ARGV) {
  73    pod2usage(
  74       message   => "body and bare parameter are mutually exclusive",
  75       -verbose  => 99,
  76       -sections => ''
  77    ) if exists $config{body};
  78    pod2usage(
  79       message   => "body-from and bare parameter are mutually exclusive",
  80       -verbose  => 99,
  81       -sections => ''
  82    ) if exists($config{'body-from'});
  83    pod2usage(
  84       message   => "only one bare command line parameter is allowed",
  85       -verbose  => 99,
  86       -sections => ''
  87    ) if @ARGV > 1;
  88    $config{'body-from'} = shift @ARGV;
  89 }
  90 if (exists $config{'body-from'}) {
  91    pod2usage(
  92       message   => "body and body-from are mutually exclusive",
  93       -verbose  => 99,
  94       -sections => ''
  95    ) if exists $config{body};
  96    $config{body} = read_file($config{'body-from'})
  97 }
  98 pod2usage(
  99    message   => "one between body, body-from or bare parameter is needed",
 100    -verbose  => 99,
 101    -sections => ''
 102 ) unless exists $config{body};
 103
 104
 105 if (exists $config{'head-from-body'}) {
 106    pod2usage(
 107       message   => "multiple head sources are not allowed",
 108       -verbose  => 99,
 109       -sections => ''
 110    ) if exists($config{head});
 111
 112    my @body = split /\n/, $config{body};
 113    my @header = splice @body, 0, $config{'head-from-body'} || 1;
 114
 115    $config{head} = join "\n", @header;
 116    $config{body} = join "\n", @body;
 117 } ## end if (exists $config{'head-from-body'...
 118
 119 if (exists $config{'head-from-paragraph'}) {
 120    pod2usage(
 121       message   => "multiple head sources are not allowed",
 122       -verbose  => 99,
 123       -sections => ''
 124    ) if exists($config{head});
 125
 126    ($config{head}, $config{body}) = split /\n\s*?\n/, $config{body}, 2;
 127 }
 128
 129 push @INC, @{$config{include}};
 130
 131 for my $file (@{$config{'modules-from'}}) {
 132    chomp(my @modules = read_file($file));
 133    push @{$config{modules}}, @modules;
 134 }
 135
 136 # Load files for explicitly requested modules
 137 my %modules = map {
 138    (my $filename = $_) =~ s{::}{/}g;
 139    $filename .= '.pm' unless $filename =~ /\./mxs;
 140    $filename => get_module_contents($filename);
 141 } @{$config{modules}};
 142
 143 # Now autoscan if requested. Already-loaded modules will be skipped
 144 if ($config{autoscan} || $config{'autoscan-list'}) {
 145    require Module::ScanDeps;
 146    require File::Temp;
 147    require Config;
 148
 149    my $fh = File::Temp->new(UNLINK => 1, SUFFIX => '.pl');
 150    binmode $fh;
 151    print {$fh} $config{body};
 152    $fh->close();
 153
 154    my @filenames = $fh->filename();
 155    my %flag_for;
 156    while (@filenames) {
 157       my $filename = shift @filenames;
 158       next if $flag_for{$filename}++;
 159       my $deps_for =
 160         Module::ScanDeps::scan_deps(files => [$filename], skip => {%modules});
 161
 162       my $priv = dir($Config::Config{privlib});
 163       my $arch = dir($Config::Config{archlib});
 164       while (my ($key, $mod) = each %$deps_for) {
 165          next if exists $modules{$key};
 166
 167          # Restrict to modules...
 168          next unless $mod->{type} eq 'module';
 169
 170          my $privPath = $priv->file($key)->as_foreign('Unix');
 171          my $archPath = $arch->file($key)->as_foreign('Unix');
 172          next if $mod->{file} eq $privPath || $mod->{file} eq $archPath;
 173
 174          $modules{$key} = read_file($mod->{file});
 175          push @filenames, $mod->{file};
 176       } ## end while (my ($key, $mod) = ...
 177    }
 178
 179    if ($config{'autoscan-list'}) {
 180       for my $path (sort keys %modules) {
 181          (my $name = $path) =~ s/\.pm$//;
 182          $name =~ s{/}{::}g;
 183          print "$name\n";
 184       }
 185       exit 0;
 186    }
 187 } ## end if ($config{autoscan})
 188
 189 $config{modules} = \%modules;
 190
 191 my $template = <<'END_OF_TEMPLATE';
 192 [% head %]
 193
 194 # __MOBUNDLE_INCLUSION__
 195 BEGIN {
 196    my %file_for = (
 197 [% while (my ($filename, $contents) = each %{$variables{modules}}) { %]
 198       '[%= $filename %]' => <<'END_OF_FILE',
 199 [%= $contents =~ s/^/ /gmxs; $contents; %]
 200 END_OF_FILE
 201 [% } %]
 202    );
 203
 204    unshift @INC, sub {
 205       my ($me, $packfile) = @_;
 206       return unless exists $file_for{$packfile};
 207       (my $text = $file_for{$packfile}) =~ s/^\ //gmxs;
 208       chop($text); # added \n at the end
 209       open my $fh, '<', \$text or die "open(): $!\n";
 210       return $fh;
 211    };
 212
 213 [% if ($variables{'add-modules-list'}) { %]
 214    our @__MOBUNDLE_MODULES__ = qw<
 215 [%    for my $path (sort {$a cmp $b} %{$variables{modules}}) {
 216          (my $name = $path) =~ s{\.pm$}{}mxs or next;
 217          $name =~ s{/}{::}gmxs;
 218 %]      [%= $name %]
 219 [%    }
 220 %]   >;
 221 [% } %]
 222 } ## end BEGIN
 223 # __MOBUNDLE_INCLUSION__
 224
 225 [% body %]
 226 END_OF_TEMPLATE
 227
 228 write_file($config{output},
 229    Template::Perlish->new()->process($template, \%config));
 230
 231 sub read_file {
 232    File::Slurp::read_file $_[0] eq '-' ? \*STDIN : $_[0];
 233 }
 234
 235 sub write_file {
 236    my $f = shift;
 237    File::Slurp::write_file(($f eq '-' ? \*STDOUT : $f), @_);
 238 }
 239
 240 sub get_module_contents {
 241    my ($filename) = @_;
 242    for my $item (@INC) {
 243       my $full_path =
 244         foreign_file('Unix', $item . '/' . $filename)->stringify();
 245       next unless -e $full_path;
 246       return scalar read_file $full_path;
 247    } ## end for my $item (@INC)
 248    carp "could not find module file: '$filename'";
 249 } ## end sub get_module_contents
 250
 251 sub unbundle {
 252    BUNDLED:
 253    for my $bundled (@_) {
 254       my $modules = read_modules($bundled);
 255       while (my ($filename, $contents) = each %$modules) {
 256          save_file($filename, $contents);
 257       }
 258    }
 259 }
 260
 261 sub save_file {
 262    my ($path, $contents) = @_;
 263    my $output = $config{output} ne '-' ? $config{output} : 'lib';
 264    my $upath = foreign_file(Unix => "$output/$path");
 265    $upath->dir()->mkpath();
 266    write_file($upath->openw(), $contents);
 267 }
 268
 269 sub read_modules {
 270    my ($bundled) = @_;
 271
 272    open my $fh, '<', $bundled
 273       or die "open('$bundled'): $OS_ERROR";
 274
 275    # read __MOBUNDLE_INCLUSION__ section
 276    my @lines;
 277    1 while scalar(<$fh>) !~ m{^\#\ __MOBUNDLE_INCLUSION__$}mxs;
 278    while (<$fh>) {
 279       last if m{^\#\ __MOBUNDLE_INCLUSION__$}mxs;
 280       push @lines, $_;
 281    }
 282    if (!@lines) {
 283       warn "nothing in $bundled\n";
 284       next BUNDLED;
 285    }
 286
 287    1 while shift(@lines) !~ m{^\s*my \s* \%file_for}mxs;
 288    unshift @lines, '(';
 289    1 while pop(@lines) !~ m{^\s*unshift \s* \@INC}mxs;
 290    my $definition = join '', @lines;
 291
 292    my %file_for = eval $definition;
 293    return %file_for if wantarray();
 294    return \%file_for;
 295 }
 296
 297 __END__
 298
 299 =head1 NAME
 300
 301 mobundle - bundle modules inside your scripts
 302
 303 =head1 VERSION
 304
 305 Ask the version number to the script itself, calling:
 306
 307    shell$ mobundle --version
 308
 309 =head1 USAGE
 310
 311    mobundle [--usage] [--help] [--man] [--version]
 312
 313    mobundle [--autoscan|--scan|-a]
 314             [--autoscan-list|--scan-list|--modules-list|-l]
 315             [--body|-b <body>]
 316             [--body-from|--script|--program|-B <filename>]
 317             [--head|-h <head>] [--head-from|-H <filename>]
 318             [--head-from-body|-S <n>]
 319             [--head-from-paragraph|-P]
 320             [--include|-I <dirname>]
 321             [--module|-m <name>]
 322             [--modules-from|-M <filename>]
 323             [--output|-o <filename>]
 324             [--standard-head|-s]
 325             [--unbundle|-u]
 326
 327 =head1 EXAMPLES
 328
 329    # the one I always look for
 330    shell$ mobundle -LPo bundled.pl -m Mod::One -m Mod::Two script.pl
 331
 332    # other useful examples
 333    shell$ mobundle -m Template::Perlish yourscript.pl
 334
 335    shell$ mobundle -m Template::Perlish --head '#!/path/to/perl' script.pl
 336
 337    shell$ mobundle -m Acme::Laugh --head-from-paragraph laugh.pl
 338
 339    # This lists all the modules that mobundle would include with
 340    # --autoscan|--scan|-a. Save it, trim it and you're done!
 341    shell$ mobundle --autoscan-list laugh.pl
 342
 343    # If you want to bundle some module that is local to your project
 344    shell$ mobundle -I ./lib -m My::Module ./bin/script.pl
 345
 346    # If you have a recently-bundled file you can easily extract modules
 347    shell% mobundle -u bundled-program.pl -o mylib
 348
 349 =head1 DESCRIPTION
 350
 351 C<mobundle> lets you bundle Perl modules inside your Perl script, in order
 352 to ship a single script instead of N separate files.
 353
 354 The underlying logic is simple: all modules are included in the generated
 355 script, and the module loading mechanism is tweaked in order to let you
 356 load the bundled modules. See the documentation for L<perlfunc/require>
 357 to understand how.
 358
 359 The generated script will be compound of three main parts: a C<head>,
 360 a section with the bundled modules and the logic to load them, and
 361 a C<body>. Briefly speaking:
 362
 363 =over
 364
 365 =item B<head>
 366
 367 this is where you should put your shabang and the C<use>s that you would
 368 like to happen before the module loading mechanism is tweaked.
 369
 370 The C<head> is guaranteed to start at the very first octet in the result,
 371 so you can put a shabang.
 372
 373 =item B<modules>
 374
 375 this part is generated automatically based on your instructions about which
 376 modules should be bundled.
 377
 378 =item B<body>
 379
 380 this is the body of your script, i.e. what your script is supposed to do.
 381 It will likely contain either C<use>s or C<require>s that need the modules
 382 that are bundled in the C<modules> section.
 383
 384 =back
 385
 386 If you have a bundled script, apart from doing it yourself you can also
 387 unbundle it, see C<< --unbundle | -u >> below.
 388
 389 =head2 Why Another? Use PAR!
 390
 391 L<PAR> is fantastic: lets you bundle all the needed components of your
 392 application inside a single executable, and ship it. But... there's a
 393 niche that it's not able to cover, at least looking at the documentation.
 394
 395 In particular, there seem to be two different operation modes, depending
 396 on your needs
 397
 398 =over
 399
 400 =item *
 401
 402 either you're willing to bundle the interpreter as well, in which case
 403 L<PAR> (or, better, L<pp>) will generate a super-executable bundling all
 404 necessary stuff
 405
 406 =item *
 407
 408 or you have to be sure that L<PAR> is installed in the target directory.
 409
 410 =back
 411
 412 My need was somewhere in between: on the one side I wasn't willing to bundle
 413 the interpreter, on the other I couldn't ensure that L<PAR> was available.
 414
 415 In particular, this kind of need arises every time that my programs only need
 416 Pure-Perl modules, that do not need any platform-specific installation
 417 process. In this case, bundling the interpreter means restricting the
 418 applicability to one (or more, at some cost) platform only; the other way
 419 is simply not acceptable in some environments.
 420
 421
 422 =head1 OPTIONS
 423
 424 =over
 425
 426 =item --add-modules-list | -L
 427
 428 adds a list of the modules that have been embedded in package variable
 429 C<@__MOBUNDLE_MODULES__>. This list can then be read, e.g.:
 430
 431    {
 432       our @__MOBUNDLE_MODULES__;
 433       print "have module <$_>\n" for @__MOBUNDLE_MODULES__;
 434    }
 435
 436 =item --autoscan | -scan | -a
 437
 438 tries to use L<Module::ScanDeps> to find non-core modules that might be
 439 needed. Note that this is not PAR, so you should be careful of what is
 440 taken in.
 441
 442 For example, L<Archive::Tar> can operate without L<IO::Zlib>, but
 443 L<Module::ScanDeps> will bring it in together with a lot of stuff.
 444
 445 =item --autoscan-list | --scan-list | --modules-list | -l
 446
 447 print out the list of modules that would be included by L</--autoscan>.
 448
 449 =item --body | -b <body>
 450
 451 turn your one-liner in a self contained script! Just pass the C<body> of your
 452 script and you're done.
 453
 454 =item --body-from | -B <filename>
 455
 456 get the body of the target script from the given filename.
 457
 458 =item --head | -h <head>
 459
 460 the C<head> is the part that will be put at the very beginning of the
 461 resulting script. Can be useful to specify a shabang.
 462
 463 =item --head-from | -H <filename>
 464
 465 get the C<head> from the given filename. See L</head>.
 466
 467 =item --head-from-body | -S <n>
 468
 469 get the C<head> taking it from the first C<n> lines of the body. See
 470 L</head> and L</body>.
 471
 472 =item --head-from-paragraph | -P
 473
 474 get the C<head> from the very first paragraph in the C<body>. See
 475 L</head> and L</body>.
 476
 477 =item --help
 478
 479 print a somewhat more verbose help, showing usage, this description of
 480 the options and some examples from the synopsis.
 481
 482 =item --include | -I <dirname>
 483
 484 add C<dirname> to @INC, which is also the directory used to look for
 485 modules' sources.
 486
 487 =item --man
 488
 489 print out the full documentation for the script.
 490
 491 =item --module | -m <name>
 492
 493 include the given module in the final script. You can specify this option
 494 multiple times for multiple modules.
 495
 496 When used with L</--autoscan>, these modules are skipped during the scan.
 497
 498 =item --modules-from | -M <filename>
 499
 500 get a list of modules to bundle from the given filename.
 501
 502 =item --output | -o <filename>
 503
 504 set a filename for output, instead of standard output. When C<-> is given,
 505 standard output is assumed.
 506
 507 When used with C<< --unbundle | -u >>, it is the name of the base output
 508 directory where modules will be written.
 509
 510 =item --standard-head | -s
 511
 512 put a standard header at the beginning of the generated script, i.e.:
 513
 514    #!/usr/bin/env perl
 515
 516 =item --unbundle | -u
 517
 518 unbundle an already-bundled script. In this case, the C<--output|-o>
 519 option is considered a directory; if not specified, the C<lib> directory
 520 is used (and created if needed).
 521
 522 Unbundling assumes that the bundled script was produced with a fairly recent
 523 version of I<mobundle>; in particular, it is important that the
 524 C<__MOBUNDLE_INCLUSION__> comments are present.
 525
 526 =item --usage
 527
 528 print a concise usage line and exit. You can specify this option
 529 multiple times for multiple modules.
 530
 531 =item --version
 532
 533 print the version of the script.
 534
 535 =back
 536
 537 =head1 CONFIGURATION AND ENVIRONMENT
 538
 539 mobundle requires no configuration files or environment variables.
 540
 541 =head1 DEPENDENCIES
 542
 543 Non-core modules needed:
 544
 545 =over
 546
 547 =item B<< File::Slurp >>
 548
 549 =item B<< Template::Perlish >>
 550
 551 =item B<< Path::Class >>
 552
 553 =item B<< Module::ScanDeps >>
 554
 555 but only if you want to use the L</--autoscan> option.
 556
 557 =back
 558
 559 Did you say that I should I<bundle> them?!?
 560
 561 =head1 BUGS AND LIMITATIONS
 562
 563 No bugs have been reported.
 564
 565 Please report any bugs or feature requests through http://rt.cpan.org/
 566
 567 Undoubtfully there are many bugs, and more limitations.
 568
 569 =head1 AUTHOR
 570
 571 Flavio Poletti C<polettix@cpan.org>
 572
 573 =head1 COPYRIGHT AND LICENSE
 574
 575 Copyright (c) 2008-2011, 2023 by Flavio Poletti C<polettix@cpan.org>.
 576
 577 Up to version 0.1.1 this program was licensed under the terms of the
 578 Artistic License 2.0.
 579
 580 Since version 0.1.2 on, this program is licensed under the Apache License,
 581 Version 2.0 (the "License"); you may not use this file except in compliance
 582 with the License.  You may obtain a copy of the License at
 583
 584     http://www.apache.org/licenses/LICENSE-2.0
 585
 586 Unless required by applicable law or agreed to in writing, software
 587 distributed under the License is distributed on an "AS IS" BASIS,
 588 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 589 See the License for the specific language governing permissions and
 590 limitations under the License.
 591
 592 If this is a bundled version of the program, the following subsections
 593 apply to the embedded modules.
 594
 595 =head2 Copyright for C<File::Slurp>
 596
 597 Copyright (c) 2003 Uri Guttman. All rights reserved.
 598
 599 This program is free software; you can redistribute it and/or modify it
 600 under the same terms as Perl itself.
 601
 602 =head2 Copyright for C<Module::ScanDeps>
 603
 604 Copyright 2002-2008 by Audrey Tang <cpan@audreyt.org>; 2005-2010 by Steffen
 605 Mueller <smueller@cpan.org>.
 606
 607 This program is free software; you can redistribute it and/or modify it
 608 under the same terms as Perl itself.
 609
 610 See http://www.perl.com/perl/misc/Artistic.html
 611
 612 =head2 Copyright for C<Path::Class>
 613
 614 Copyright (c) Ken Williams. All rights reserved.
 615
 616 This library is free software; you can redistribute it and/or modify it
 617 under the same terms as Perl itself.
 618
 619 =head2 Copyright for C<Template::Perlish>
 620
 621 Copyright (c) 2008-2016 by Flavio Poletti polettix@cpan.org.
 622
 623 This module is free software. You can redistribute it and/or modify it under
 624 the terms of the Artistic License 2.0.
 625
 626 This program is distributed in the hope that it will be useful, but without
 627 any warranty; without even the implied warranty of merchantability or
 628 fitness for a particular purpose.
 629
 630 =cut