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' => []);
  19 GetOptions(
  20    \%config,
  21    qw(
  22      usage help man version
  23      autoscan|scan|a!
  24      body|b=s
  25      body-from|script|program|B=s
  26      head|h=s
  27      head-from|H=s
  28      head-from-body|S:i
  29      head-from-paragraph|P!
  30      modules|module|m=s@
  31      modules-from|M=s@
  32      output|o=s
  33      standard-head|s!
  34      )
  35 );
  36 pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
  37   if $config{version};
  38 pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
  39 pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
  40   if $config{help};
  41 pod2usage(-verbose => 2) if $config{man};
  42
  43 # Various checks for input parameter consistence and overriding
  44 pod2usage(
  45    message   => "head and standard-head are mutually exclusive",
  46    -verbose  => 99,
  47    -sections => ''
  48 ) if exists($config{head}) && exists($config{'standard-head'});
  49 $config{head} = "#!/usr/bin/env perl\n"
  50   if exists $config{'standard-head'};
  51
  52 pod2usage(
  53    message   => "(standard-)head and head-from are mutually exclusive",
  54    -verbose  => 99,
  55    -sections => ''
  56 ) if exists($config{head}) && exists($config{'head-from'});
  57 $config{head} = read_file($config{'head-from'})
  58   if exists $config{'head-from'};
  59
  60 pod2usage(
  61    message   => "body and body-from are mutually exclusive",
  62    -verbose  => 99,
  63    -sections => ''
  64 ) if exists($config{body}) && exists($config{'body-from'});
  65 $config{body} = read_file($config{'body-from'})
  66   if exists $config{'body-from'};
  67
  68 if (exists $config{'head-from-body'}) {
  69    pod2usage(
  70       message   => "multiple head sources are not allowed",
  71       -verbose  => 99,
  72       -sections => ''
  73    ) if exists($config{head});
  74
  75    my @body = split /\n/, $config{body};
  76    my @header = splice @body, 0, $config{'head-from-body'} || 1;
  77
  78    $config{head} = join "\n", @header;
  79    $config{body} = join "\n", @body;
  80 } ## end if (exists $config{'head-from-body'...
  81
  82 if (exists $config{'head-from-paragraph'}) {
  83    pod2usage(
  84       message   => "multiple head sources are not allowed",
  85       -verbose  => 99,
  86       -sections => ''
  87    ) if exists($config{head});
  88
  89    ($config{head}, $config{body}) = split /\n\s*?\n/, $config{body}, 2;
  90 }
  91
  92 for my $file (@{$config{'modules-from'}}) {
  93    chomp(my @modules = read_file($file));
  94    push @{$config{modules}}, @modules;
  95 }
  96
  97 # Load files for explicitly requested modules
  98 my %modules = map {
  99    (my $filename = $_) =~ s{::}{/}g;
 100    $filename .= '.pm' unless $filename =~ /\./mxs;
 101    $filename => get_module_contents($filename);
 102 } @{$config{modules}};
 103
 104 # Now autoscan if requested. Already-loaded modules will be skipped
 105 if ($config{autoscan}) {
 106    require Module::ScanDeps;
 107    require File::Temp;
 108    require Config;
 109
 110    my $fh = File::Temp->new(UNLINK => 1, SUFFIX => '.pl');
 111    binmode $fh;
 112    print {$fh} $config{body};
 113    $fh->close();
 114
 115    my $filename = $fh->filename();
 116    my $deps_for =
 117      Module::ScanDeps::scan_deps(files => [$filename], skip => {%modules});
 118
 119    my $priv = dir($Config::Config{privlib});
 120    my $arch = dir($Config::Config{archlib});
 121    while (my ($key, $mod) = each %$deps_for) {
 122       # Restrict to modules...
 123       next unless $mod->{type} eq 'module';
 124
 125       my $privPath = $priv->file($key)->as_foreign('Unix');
 126       my $archPath = $arch->file($key)->as_foreign('Unix');
 127       next if $mod->{file} eq $privPath || $mod->{file} eq $archPath;
 128
 129       $modules{$key} = read_file($mod->{file});
 130    } ## end while (my ($key, $mod) = ...
 131 } ## end if ($config{autoscan})
 132
 133 $config{modules} = \%modules;
 134
 135 my $template = <<'END_OF_TEMPLATE';
 136 [% head %]
 137
 138 BEGIN {
 139    my %file_for = (
 140 [% while (my ($filename, $contents) = each %{$variables{modules}}) { %]
 141       '[%= $filename %]' => <<'END_OF_FILE',
 142 [%= $contents =~ s/^/ /gmxs; $contents; %]
 143 END_OF_FILE
 144 [% } %]
 145    );
 146
 147    unshift @INC, sub {
 148       my ($me, $packfile) = @_;
 149       return unless exists $file_for{$packfile};
 150       (my $text = $file_for{$packfile}) =~ s/^\ //gmxs;
 151       chop($text); # added \n at the end
 152       open my $fh, '<', \$text or die "open(): $!\n";
 153       return $fh;
 154    };
 155 } ## end BEGIN
 156
 157 [% body %]
 158 END_OF_TEMPLATE
 159
 160 write_file($config{output},
 161    Template::Perlish->new()->process($template, \%config));
 162
 163 sub read_file {
 164    File::Slurp::read_file $_[0] eq '-' ? \*STDIN : $_[0];
 165 }
 166
 167 sub write_file {
 168    my $f = shift;
 169    File::Slurp::write_file(($f eq '-' ? \*STDOUT : $f), @_);
 170 }
 171
 172 sub get_module_contents {
 173    my ($filename) = @_;
 174    for my $item (@INC) {
 175       my $full_path =
 176         foreign_file('Unix', $item . '/' . $filename)->stringify();
 177       next unless -e $full_path;
 178       return scalar read_file $full_path;
 179    } ## end for my $item (@INC)
 180    carp "could not find module file: '$filename'";
 181 } ## end sub get_module_contents
 182
 183 __END__
 184
 185 =head1 NAME
 186
 187 mobundle - bundle modules inside your scripts
 188
 189 =head1 VERSION
 190
 191 Ask the version number to the script itself, calling:
 192
 193    shell$ mobundle --version
 194
 195 =head1 USAGE
 196
 197    mobundle [--usage] [--help] [--man] [--version]
 198
 199    mobundle [--autoscan|--scan|-a] [--body|-b <body>]
 200             [--body-from|--script|--program|-B <filename>]
 201             [--head|-h <head>] [--head-from|-H <filename>]
 202             [--head-from-body|-S <n>] [--head-from-paragraph|-P]
 203             [--module|-m <name>] [--modules-from|-M <filename>]
 204             [--output|-o <filename>] [--standard-head|-s]
 205
 206 =head1 EXAMPLES
 207
 208    shell$ mobundle -m Template::Perlish yourscript.pl
 209
 210    shell$ mobundle -m Template::Perlish --head '#!/path/to/perl' yourscript.pl
 211
 212    shell$ mobundle -m Acme::Laugh --head-from-paragraph laugh.pl
 213
 214 =head1 DESCRIPTION
 215
 216 C<mobundle> lets you bundle Perl modules inside your Perl script, in order
 217 to ship a single script instead of N separate files.
 218
 219 The underlying logic is simple: all modules are included in the generated
 220 script, and the module loading mechanism is tweaked in order to let you
 221 load the bundled modules. See the documentation for L<perlfunc/require>
 222 to understand how.
 223
 224 The generated script will be compound of three main parts: a C<head>,
 225 a section with the bundled modules and the logic to load them, and
 226 a C<body>. Briefly speaking:
 227
 228 =over
 229
 230 =item B<head>
 231
 232 this is where you should put your shabang and the C<use>s that you would
 233 like to happen before the module loading mechanism is tweaked.
 234
 235 The C<head> is guaranteed to start at the very first octet in the result,
 236 so you can put a shabang.
 237
 238 =item B<modules>
 239
 240 this part is generated automatically based on your instructions about which
 241 modules should be bundled.
 242
 243 =item B<body>
 244
 245 this is the body of your script, i.e. what your script is supposed to do.
 246 It will likely contain either C<use>s or C<require>s that need the modules
 247 that are bundled in the C<modules> section.
 248
 249 =back
 250
 251 =head2 Why Another? Use PAR!
 252
 253 L<PAR> is fantastic: lets you bundle all the needed components of your
 254 application inside a single executable, and ship it. But... there's a
 255 niche that it's not able to cover, at least looking at the documentation.
 256
 257 In particular, there seem to be two different operation modes, depending
 258 on your needs
 259
 260 =over
 261
 262 =item *
 263
 264 either you're willing to bundle the interpreter as well, in which case
 265 L<PAR> (or, better, L<pp>) will generate a super-executable bundling all
 266 necessary stuff
 267
 268 =item *
 269
 270 or you have to be sure that L<PAR> is installed in the target directory.
 271
 272 =back
 273
 274 My need was somewhere in between: on the one side I wasn't willing to bundle
 275 the interpreter, on the other I couldn't ensure that L<PAR> was available.
 276
 277 In particular, this kind of need arises every time that my programs only need
 278 Pure-Perl modules, that do not need any platform-specific installation
 279 process. In this case, bundling the interpreter means restricting the
 280 applicability to one (or more, at some cost) platform only; the other way
 281 is simply not acceptable in some environments.
 282
 283
 284 =head1 OPTIONS
 285
 286 =over
 287
 288 =item --autoscan | -scan | -a
 289
 290 tries to use L<Module::ScanDeps> to find non-core modules that might be
 291 needed. Note that this is not PAR, so you should be careful of what is
 292 taken in.
 293
 294 For example, L<Archive::Tar> can operate without L<IO::Zlib>, but
 295 L<Module::ScanDeps> will bring it in together with a lot of stuff.
 296
 297 =item --body | -b <body>
 298
 299 turn your one-liner in a self contained script! Just pass the C<body> of your
 300 script and you're done.
 301
 302 =item --body-from | -B <filename>
 303
 304 get the body of the target script from the given filename.
 305
 306 =item --head | -h <head>
 307
 308 the C<head> is the part that will be put at the very beginning of the
 309 resulting script. Can be useful to specify a shabang.
 310
 311 =item --head-from | -H <filename>
 312
 313 get the C<head> from the given filename. See L</head>.
 314
 315 =item --head-from-body | -S <n>
 316
 317 get the C<head> taking it from the first C<n> lines of the body. See
 318 L</head> and L</body>.
 319
 320 =item --head-from-paragraph | -P
 321
 322 get the C<head> from the very first paragraph in the C<body>. See
 323 L</head> and L</body>.
 324
 325 =item --help
 326
 327 print a somewhat more verbose help, showing usage, this description of
 328 the options and some examples from the synopsis.
 329
 330 =item --man
 331
 332 print out the full documentation for the script.
 333
 334 =item --module | -m <name>
 335
 336 include the given module in the final script. You can specify this option
 337 multiple times for multiple modules.
 338
 339 When used with L</--autoscan>, these modules are skipped during the scan.
 340
 341 =item --modules-from | -M <filename>
 342
 343 get a list of modules to bundle from the given filename.
 344
 345 =item --usage
 346
 347 print a concise usage line and exit. You can specify this option
 348 multiple times for multiple modules.
 349
 350 When used with L</--autoscan>, these modules are skipped during the scan.
 351
 352 =item --output | -o <filename>
 353
 354 set a filename for output, instead of standard output. When C<-> is given,
 355 standard output is assumed.
 356
 357 =item --standard-head | -s
 358
 359 put a standard header at the beginning of the generated script, i.e.:
 360
 361    #!/usr/bin/env perl
 362
 363 =item --version
 364
 365 print the version of the script.
 366
 367 =back
 368
 369 =head1 CONFIGURATION AND ENVIRONMENT
 370
 371 mobundle requires no configuration files or environment variables.
 372
 373 =head1 DEPENDENCIES
 374
 375 Non-core modules needed:
 376
 377 =over
 378
 379 =item B<< File::Slurp >>
 380
 381 =item B<< Template::Perlish >>
 382
 383 =item B<< Path::Class >>
 384
 385 =item B<< Module::ScanDeps >>
 386
 387 but only if you want to use the L</--autoscan> option.
 388
 389 =back
 390
 391 Did you say that I should I<bundle> them?!?
 392
 393 =head1 BUGS AND LIMITATIONS
 394
 395 No bugs have been reported.
 396
 397 Please report any bugs or feature requests through http://rt.cpan.org/
 398
 399 Undoubtfully there are many bugs, and more limitations.
 400
 401 =head1 AUTHOR
 402
 403 Flavio Poletti C<flavio@polettix.it>
 404
 405 =head1 LICENCE AND COPYRIGHT
 406
 407 Copyright (c) 2008, Flavio Poletti C<flavio@polettix.it>. All rights reserved.
 408
 409 This script is free software; you can redistribute it and/or
 410 modify it under the same terms as Perl itself. See L<perlartistic>
 411 and L<perlgpl>.
 412
 413 Questo script è software libero: potete ridistribuirlo e/o
 414 modificarlo negli stessi termini di Perl stesso. Vedete anche
 415 L<perlartistic> e L<perlgpl>.
 416
 417
 418 =head1 DISCLAIMER OF WARRANTY
 419
 420 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 421 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 422 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 423 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 424 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 425 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 426 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 427 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 428 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 429
 430 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 431 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 432 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 433 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 434 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 435 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 436 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 437 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 438 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 439 SUCH DAMAGES.
 440
 441 =head1 NEGAZIONE DELLA GARANZIA
 442
 443 Poiché questo software viene dato con una licenza gratuita, non
 444 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
 445 dalle leggi applicabili. A meno di quanto possa essere specificato
 446 altrove, il proprietario e detentore del copyright fornisce questo
 447 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
 448 o implicita, includendo fra l'altro (senza però limitarsi a questo)
 449 eventuali garanzie implicite di commerciabilità e adeguatezza per
 450 uno scopo particolare. L'intero rischio riguardo alla qualità ed
 451 alle prestazioni di questo software rimane a voi. Se il software
 452 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
 453 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
 454
 455 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
 456 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
 457 di copyright, o qualunque altra parte che possa modificare, o redistribuire
 458 questo software così come consentito dalla licenza di cui sopra, potrà
 459 essere considerato responsabile nei vostri confronti per danni, ivi
 460 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
 461 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
 462 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
 463 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
 464 sostenute da voi o da terze parti o un fallimento del software ad
 465 operare con un qualsivoglia altro software. Tale negazione di garanzia
 466 rimane in essere anche se i dententori del copyright, o qualsiasi altra
 467 parte, è stata avvisata della possibilità di tali danneggiamenti.
 468
 469 Se decidete di utilizzare questo software, lo fate a vostro rischio
 470 e pericolo. Se pensate che i termini di questa negazione di garanzia
 471 non si confacciano alle vostre esigenze, o al vostro modo di
 472 considerare un software, o ancora al modo in cui avete sempre trattato
 473 software di terze parti, non usatelo. Se lo usate, accettate espressamente
 474 questa negazione di garanzia e la piena responsabilità per qualsiasi
 475 tipo di danno, di qualsiasi natura, possa derivarne.
 476
 477 =cut