[ViewVC] Annotation of: cvs/App-Staticperl/bin/staticperl

#!/bin/sh

#############################################################################
# configuration to fill in

PERLVER=5.12.2 # 5.8.9 is also a good choice
STATICPERL=~/.staticperl
CPAN=http://mirror.netcologne.de/cpan/ # which mirror to use
EMAIL="read the documentation <rtfm@example.org>"

MKBUNDLE="$STATICPERL/mkbundle"

# perl build variables
PREFIX="$STATICPERL/perl" # where the perl gets installed
PERL_CPPFLAGS="-DPERL_DISABLE_PMC -DPERL_ARENA_SIZE=65536 -D_GNU_SOURCE -DNDEBUG -USITELIB_EXP -USITEARCHEXP -UARCHLIB_EXP"
PERL_OPTIMIZE="-Os -ffunction-sections -fdata-sections -finline-limit=8 -ffast-math"

ARCH="$(uname -m)"

case "$ARCH" in
   i*86 | x86_64 | amd64 )
      PERL_OPTIMIZE="$PERL_OPTIMIZE -mpush-args -mno-inline-stringops-dynamically -mno-align-stringops -mno-ieee-fp" # x86/amd64
      case "$ARCH" in
         i*86 )
            PERL_OPTIMIZE="$PERL_OPTIMIZE -fomit-frame-pointer -march=pentium3 -mtune=i386" # x86 only
            ;;
      esac
      ;;
esac

# -Wl,--gc-sections makes it impossible to check for undefined references
# for some reason so we need to patch away the "-no" after Configure and before make :/
# -z muldefs is to work around uclibc's pthread static linking bug
PERL_LDFLAGS="-Wl,--no-gc-sections -z muldefs"
PERL_LIBS="-lm -lcrypt" # perl loves to add lotsa crap itself

# some configuration options for modules
export PERL_MM_USE_DEFAULT=1
#export CORO_INTERFACE=p # needed without nptl on x86, due to bugs in linuxthreads - very slow
export EV_EXTRA_DEFS='-DEV_FEATURES=4+8+16+64 -DEV_USE_SELECT=0 -DEV_USE_POLL=1 -DEV_USE_EPOLL=1 -DEV_NO_LOOPS -DEV_COMPAT3=0'

# which extra modules to install by default from CPAN that are
# required by mkbundle
EXTRA_MODULES="common::sense Pod::Strip PPI::XS Pod::Usage"

# overridable functions
postconfigure() { : ; }
postbuild()     { : ; }
postinstall()   { : ; }

# now source user config, if any
[ -r /etc/staticperlrc ] && . /etc/staticperlrc
[ -r ~/.staticperlrc   ] && . ~/.staticperlrc
[ -r "$STATICPERL/rc"  ] && . "$STATICPERL/rc"

#############################################################################
# support

# set version in a way that Makefile.PL can extract
VERSION=VERSION; eval \
$VERSION=0.1

BZ2=bz2
BZIP2=bzip2

fatal() {
   printf -- "\nFATAL: %s\n\n" "$*" >&2
   exit 1
}

verbose() {
   printf -- "%s\n" "$*"
}

verblock() {
   verbose
   verbose "***"
   while read line; do
      verbose "*** $line"
   done
   verbose "***"
   verbose
}

rcd() {
   cd "$1" || fatal "$1: cannot enter"
}

trace() {
   prefix="$1"; shift
#   "$@" 2>&1 | while read line; do
#      echo "$prefix: $line"
#   done
   "$@"
}

trap wait 0

#############################################################################
# clean

distclean() {
   verblock <<EOF
deleting everything installed by this script
EOF

   rm -rf "$STATICPERL"
}

#############################################################################
# download/configure/compile/install perl

clean() {
   cd "$STATICPERL/src/perl-$PERLVER" 2>/dev/null || return

   rm -f staticstamp.configure
   make distclean >/dev/null 2>&1
}

fetch() {
   rcd "$STATICPERL"

   mkdir -p src
   rcd src

   if ! [ -d "perl-$PERLVER" ]; then
      if ! [ -e "perl-$PERLVER.tar.$BZ2" ]; then

         URL="$CPAN/src/5.0/perl-$PERLVER.tar.$BZ2"

         verblock <<EOF
downloading perl
to manually download perl yourself, place
perl-$PERLVER.tar.$BZ2 in $STATICPERL
trying $URL
EOF

         curl >perl-$PERLVER.tar.$BZ2~ "$URL" \
            || wget -O perl-$PERLVER.tar.$BZ2~ "$URL" \
            || fatal "$URL: error during downloading"
         mv perl-$PERLVER.tar.$BZ2~ perl-$PERLVER.tar.$BZ2
      fi

      verblock <<EOF
unpacking perl
EOF

      mkdir -p unpack
      $BZIP2 -d <perl-$PERLVER.tar.bz2 | tar xpC unpack \
         || fatal "perl-$PERLVER.tar.bz2: error during unpacking"
      mv unpack/perl-$PERLVER perl-$PERLVER
      rmdir -p unpack
   fi
}

# similar to GNU-sed -i or perl -pi
sedreplace() {
   sed -e "$1" <"$2" > "$2~" || fatal "error while running sed"
   mv "$2~" "$2"
}

configure() {
   fetch

   rcd "$STATICPERL/src/perl-$PERLVER"

   [ -e staticstamp.configure ] && return

   verblock <<EOF
configuring $STATICPERL/src/perl-$PERLVER
EOF

   clean

   rm -f "$PREFIX/staticstamp.install"

   # I hate them
   grep -q -- -fstack-protector Configure && \
      sedreplace 's/-fstack-protector/-fno-stack-protector/g' Configure

#   trace configure \
   sh Configure -Duselargefiles \
                -Uuse64bitint \
                -Dusemymalloc=n \
                -Uusedl \
                -Uusethreads \
                -Uuseithreads \
                -Uusemultiplicity \
                -Duseperlio \
                -Uusesfio \
                -Uuseshrplib \
                -Dcppflags="$PERL_CPPFLAGS" \
                -Dccflags="-g2 -fno-strict-aliasing" \
                -Doptimize="$PERL_OPTIMIZE" \
                -Dldflags="$PERL_LDFLAGS" \
                -Dlibs="$PERL_LIBS" \
                -Dprefix="$PREFIX" \
                -Dbin="$PREFIX/bin" \
                -Dprivlib="$PREFIX/plib" \
                -Darchlib="$PREFIX/plib" \
                -Uusevendorprefix \
                -Dsitelib="$PREFIX/plib" \
                -Dsitearch="$PREFIX/plib" \
                -Usitelibexp \
                -Uman1dir \
                -Uman3dir \
                -Usiteman1dir \
                -Usiteman3dir \
                -Dpager=/usr/bin/less \
                -Demail="$EMAIL" \
                -Dcf_email="$EMAIL" \
                -Dcf_by="$EMAIL" \
                -dE || fatal "Configure failed"

   sedreplace '
      s/-Wl,--no-gc-sections/-Wl,--gc-sections/g
      s/ *-fno-stack-protector */ /g
   ' config.sh

   sh Configure -S || fatal "Configure -S failed"

   postconfigure || fatal "postconfigure hook failed"

   touch staticstamp.configure
}

build() {
   configure

   rcd "$STATICPERL/src/perl-$PERLVER"

   verblock <<EOF
building $STATICPERL/src/perl-$PERLVER
EOF

   rm -f "$PREFIX/staticstamp.install"

   make || fatal "make: error while building perl"

   postbuild || fatal "postbuild hook failed"
}

install() {
   [ -e "$PREFIX/staticstamp.install" ] && return

   build

   verblock <<EOF
installing $STATICPERL/src/perl-$PERLVER
to $PREFIX
EOF

   rm -rf "$PREFIX"
   
   make install || fatal "make install: error while installing"

   # create a "make install" replacement for CPAN
   cat >"$PREFIX"/bin/cpan-make-install <<EOF
make install UNINST=1
if find blib/arch/auto -type f | grep -q -v .exists; then
   echo Probably an XS module, rebuilding perl
   make perl
   rm -f "$PREFIX"/bin/perl
   make -f Makefile.aperl inst_perl
   make -f Makefile.aperl map_clean
fi
EOF
   chmod 755 "$PREFIX"/bin/cpan-make-install

   "$PREFIX"/bin/perl -MCPAN -e '
      CPAN::Shell->o (conf => urllist => push => "'"$CPAN"'");
      CPAN::Shell->o (conf => q<init>);
      CPAN::Shell->o (conf => q<cpan_home>, "'"$STATICPERL"'/cpan");
      CPAN::Shell->o (conf => q<build_dir>, "'"$STATICPERL"'/cpan/build");
      CPAN::Shell->o (conf => q<prefs_dir>, "'"$STATICPERL"'/cpan/prefs");
      CPAN::Shell->o (conf => q<histfile> , "'"$STATICPERL"'/cpan/histfile");
      CPAN::Shell->o (conf => q<keep_source_where>, "'"$STATICPERL"'/cpan/sources");
      CPAN::Shell->o (conf => q<make_install_make_command>, "'"$PREFIX"'/bin/cpan-make-install");
      CPAN::Shell->o (conf => q<prerequisites_policy>, q<follow>);
      CPAN::Shell->o (conf => q<build_requires_install_policy>, q<no>);
      CPAN::Shell->o (conf => q<commit>);
   ' || fatal "error while initialising CPAN"

   NOCHECK_INSTALL=+
   instcpan $EXTRA_MODULES

   postinstall || fatal "postinstall hook failed"

   touch "$PREFIX/staticstamp.install"
}

#############################################################################
# install a module from CPAN

instcpan() {
   [ $NOCHECK_INSTALL ] || install

   verblock <<EOF
installing modules from CPAN
$@
EOF

   for mod in "$@"; do
      "$PREFIX"/bin/perl -MCPAN -e 'notest install => "'"$mod"'"' \
         || fatal "$mod: unable to install from CPAN"
   done
   rm -rf "$STATICPERL/build"
}

#############################################################################
# install a module from unpacked sources

instsrc() {
   [ $NOCHECK_INSTALL ] || install

   verblock <<EOF
installing modules from source
$@
EOF

   for mod in "$@"; do
      echo
      echo $mod
      (
         rcd $mod
         make -f Makefile.aperl map_clean >/dev/null 2>&1
         make distclean >/dev/null 2>&1
         "$PREFIX"/bin/perl Makefile.PL || fatal "$mod: error running Makefile.PL"
         make || fatal "$mod: error building module"
         "$PREFIX"/bin/cpan-make-install || fatal "$mod: error installing module"
         make distclean >/dev/null 2>&1
         exit 0
      ) || exit $?
   done
}

#############################################################################
# do schmorpy stuff

MODSRCDIR=~/src

instmodsrc() {
   for mod in "$@"; do
      instmod_src "$MODSRCDIR/$mod"
   done
}

install_schmorp() {
   install

   instcpan Data::Dump Term::ReadLine::Perl Term::ANSIColor Term::ReadKey
   instcpan Digest::SHA Digest::MD6 Digest::SHA256 Digest::MD4 Digest::HMAC_MD5 Digest::HMAC_MD6 Digest::FNV
   #instcpan Net::SSLeay # requires static -ldl

   instmodsrc common-sense Crypt-Twofish2 Array-Heap Convert-Scalar Compress-LZF JSON-XS
   instmodsrc EV Guard Async-Interrupt IO-AIO
   instmodsrc AnyEvent AnyEvent-AIO Coro AnyEvent-HTTP
   instmodsrc Linux-Inotify2 EV-Loop-Async

   instcpan AnyEvent::HTTPD
}

#############################################################################
# main

podusage() {
   echo
   if [ -e "$PREFIX/bin/perl" ]; then
      "$PREFIX/bin/perl" -MPod::Usage -e \
         'pod2usage -input => *STDIN, -output => *STDOUT, -verbose => '$1', -exitval => 0, -noperldoc => 1' <"$0" \
         2>/dev/null && exit
   fi
   # try whatever perl we can find
   perl -MPod::Usage -e \
      'pod2usage -input => *STDIN, -output => *STDOUT, -verbose => '$1', -exitval => 0, -noperldoc => 1' <"$0" \
      2>/dev/null && exit

   fatal "displaying documentation requires a working perl - try '$0 install' first"
}

usage() {
   podusage 0
}

catmkbundle() {
   {
      read dummy
      echo "#!$PREFIX/bin/perl"
      cat
   } <<'MKBUNDLE'
#!/opt/bin/perl

#############################################################################
# cannot load modules till after the tracer BEGIN block

our $VERBOSE  = 1;
our $STRIP    = "pod"; # none, pod or ppi
our $PERL     = 0;
our $VERIFY   = 0;
our $STATIC   = 0;

my $PREFIX  = "bundle";
my $PACKAGE = "static";

my %pm;
my @libs;
my @static_ext;
my $extralibs;

@ARGV
   or die "$0: use 'staticperl help' (or read the sources of staticperl)\n";

$|=1;

our ($TRACER_W, $TRACER_R);

sub find_inc($) {
   for (@INC) {
      next if ref;
      return $_ if -e "$_/$_[0]";
   }

   undef
}

BEGIN {
   # create a loader process to detect @INC requests before we load any modules
   my ($W_TRACER, $R_TRACER); # used by tracer

   pipe $R_TRACER, $TRACER_W or die "pipe: $!";
   pipe $TRACER_R, $W_TRACER or die "pipe: $!";

   unless (fork) {
      close $TRACER_R;
      close $TRACER_W;

      unshift @INC, sub {
         my $dir = find_inc $_[1]
            or return;

         syswrite $W_TRACER, "-\n$dir\n$_[1]\n";

         open my $fh, "<:perlio", "$dir/$_[1]"
            or warn "ERROR: $dir/$_[1]: $!\n";

         $fh
      };

      while (<$R_TRACER>) {
         if (/use (.*)$/) {
            my $mod = $1;
            eval "require $mod";
            warn "ERROR: $@ (while loading '$mod')\n"
               if $@;
            syswrite $W_TRACER, "\n";
         } elsif (/eval (.*)$/) {
            my $eval = $1;
            eval $eval;
            warn "ERROR: $@ (in '$eval')\n"
               if $@;
         }
      }

      exit 0;
   }
}

# module loading is now safe
use Config;

sub trace_module {
   syswrite $TRACER_W, "use $_[0]\n";

   for (;;) {
      <$TRACER_R> =~ /^-$/ or last;
      my $dir  = <$TRACER_R>; chomp $dir;
      my $name = <$TRACER_R>; chomp $name;

      $pm{$name} = "$dir/$name";

      if ($name =~ /^(.*)\.pm$/) {
         my $auto    = "auto/$1";
         my $autodir = "$dir/$auto";

         if (-d $autodir) {
            opendir my $dir, $autodir
               or die "$autodir: $!\n";

            for (readdir $dir) {
               # AutoLoader
               $pm{"$auto/$_"} = "$autodir/$_"
                  if /\.(?:al|ix)$/;

               # static ext
               if (/\Q$Config{_a}\E$/o) {
                  push @libs, "$autodir/$_";
                  push @static_ext, $name;
               }

               # extralibs.ld
               if ($_ eq "extralibs.ld") {
                  open my $fh, "<:perlio", "$autodir/$_"
                     or die "$autodir/$_";

                  local $/;
                  $extralibs .= " " . <$fh>;
               }

               # dynamic object
               warn "WARNING: found shared object - can't link statically ($_)\n"
                  if /\.\Q$Config{dlext}\E$/o;

               #TODO: extralibs?
            }
         }
      }
   }
}

sub trace_eval {
   syswrite $TRACER_W, "eval $_[0]\n";
}

sub trace_finish {
   close $TRACER_W;
   close $TRACER_R;
}

#############################################################################
# now we can use modules

use common::sense;
use Digest::MD5;

sub dump_string {
   my ($fh, $data) = @_;

   if (length $data) {
      for (
         my $ofs = 0;
         length (my $substr = substr $data, $ofs, 80);
         $ofs += 80
      )  {
         $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge;
         $substr =~ s/\?/\\?/g; # trigraphs...
         print $fh "  \"$substr\"\n";
      }
   } else {
      print $fh "  \"\"\n";
   }
}

# required for @INC loading, unfortunately
trace_module "PerlIO::scalar";

#trace_module "Term::ReadLine::readline"; # Term::ReadLine::Perl dependency
# URI is difficult
#trace_module "URI::http";
#trace_module "URI::_generic";

sub cmd_boot {
   $pm{"//boot"} = $_[0];
}

sub cmd_add {
   $_[0] =~ /^(.*)(?:\s*(\S+))$/
      or die "$_[0]: cannot parse";

   my $file = $1;
   my $as   = defined $2 ? $2 : "/$1";

   $pm{$as} = $file;
}

sub cmd_file {
   open my $fh, "<", $_[0]
      or die "$_[0]: $!\n";

   while (<$fh>) {
      chomp;
      my ($cmd, $args) = split / /, $_, 2;

      if ($cmd eq "strip") {
         $STRIP = $args;
      } elsif ($cmd eq "eval") {
         trace_eval $_;
      } elsif ($cmd eq "use") {
         trace_module $_
            for split / /, $args;
      } elsif ($cmd eq "boot") {
         cmd_boot $args;
      } elsif ($cmd eq "static") {
         $STATIC = 1;
      } elsif ($cmd eq "add") {
         cmd_add $args;
      } elsif (/^\s*#/) {
         # comment
      } elsif (/\S/) {
         die "$_: unsupported directive\n";
      }
   }
}

use Getopt::Long;

Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");

GetOptions
   "strip=s"   => \$STRIP,
   "verbose|v" => sub { ++$VERBOSE },
   "quiet|q"   => sub { --$VERBOSE },
   "perl"      => \$PERL,
   "eval=s"    => sub { trace_eval   $_[1] },
   "use|M=s"   => sub { trace_module $_[1] },
   "boot=s"    => sub { cmd_boot     $_[1] },
   "add=s"     => sub { cmd_add      $_[1] },
   "static"    => sub { $STATIC = 1 },
   "<>"        => sub { cmd_file     $_[1] },
   or exit 1;

my $data;
my @index;
my @order = sort {
   length $a <=> length $b
      or $a cmp $b
} keys %pm;

# sorting by name - better compression, but needs more metadata
# sorting by length - faster lookup
# usually, the metadata overhead beats the loss through compression

for my $pm (@order) {
   my $path = $pm{$pm};

   128 > length $pm
      or die "$pm: path too long (only 128 octets supported)\n";

   my $src = ref $path
           ? $$path
           : do {
              open my $pm, "<:perlio", $path
                 or die "$path: $!";

              local $/;
              
              <$pm>
           };

   if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) {
      if ($src =~ /^    unimpl \"/m) {
         warn "$pm: skipping (not implemented anyways).\n"
            if $VERBOSE >= 2;
         next;
      }
   }

   if ($STRIP =~ /ppi/i) {
      require PPI;

      my $ppi = PPI::Document->new (\$src);
      $ppi->prune ("PPI::Token::Comment");
      $ppi->prune ("PPI::Token::Pod");

      # prune END stuff
      for (my $last = $ppi->last_element; $last; ) {
         my $prev = $last->previous_token;

         if ($last->isa (PPI::Token::Whitespace::)) {
            $last->delete;
         } elsif ($last->isa (PPI::Statement::End::)) {
            $last->delete;
            last;
         } elsif ($last->isa (PPI::Token::Pod::)) {
            $last->delete;
         } else {
            last;
         }

         $last = $prev;
      }

      # prune some but not all insignificant whitespace
      for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) {
         my $prev = $ws->previous_token;
         my $next = $ws->next_token;

         if (!$prev || !$next) {
            $ws->delete;
         } else {
            if (
               $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
               or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
               or $prev->isa (PPI::Token::Structure::)
               # decrease size, decrease compressability
               #or ($prev->isa (PPI::Token::Word::)
               #       && (PPI::Token::Symbol:: eq ref $next
               #           || $next->isa (PPI::Structure::Block::)
               #           || $next->isa (PPI::Structure::List::)
               #           || $next->isa (PPI::Structure::Condition::)))
            ) {
               $ws->delete;
            } elsif ($prev->isa (PPI::Token::Whitespace::)) {
               $ws->{content} = ' ';
               $prev->delete;
            } else {
               $ws->{content} = ' ';
            }
         }
      }

      # prune whitespace around blocks
      if (0) {
         # these usually decrease size, but decrease compressability more
         for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) {
            for my $node (@{ $ppi->find ($struct) }) {
               my $n1 = $node->first_token;
               my $n2 = $n1->previous_token;
               $n1->delete if $n1->isa (PPI::Token::Whitespace::);
               $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
               my $n1 = $node->last_token;
               my $n2 = $n1->next_token;
               $n1->delete if $n1->isa (PPI::Token::Whitespace::);
               $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::);
            }
         }

         for my $node (@{ $ppi->find (PPI::Structure::List::) }) {
            my $n1 = $node->first_token;
            $n1->delete if $n1->isa (PPI::Token::Whitespace::);
            my $n1 = $node->last_token;
            $n1->delete if $n1->isa (PPI::Token::Whitespace::);
         }
      }

      # reformat qw() lists which often have lots of whitespace
      for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) {
         if ($node->{content} =~ /^qw(.)(.*)(.)$/s) {
            my ($a, $qw, $b) = ($1, $2, $3);
            $qw =~ s/^\s+//;
            $qw =~ s/\s+$//;
            $qw =~ s/\s+/ /g;
            $node->{content} = "qw$a$qw$b";
         }
      }

      $src = $ppi->serialize;
   } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod
      require Pod::Strip;

      my $stripper = Pod::Strip->new;

      my $out;
      $stripper->output_string (\$out);
      $stripper->parse_string_document ($src);
      $src = $out;
   }

   if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") {
      if (open my $fh, "-|") {
         <$fh>;
      } else {
         eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
         exit 0;
      }
   }

#   if ($pm eq "Opcode.pm") {
#      open my $fh, ">x" or die; print $fh $src;#d#
#      exit 1;
#   }

   warn "adding $pm\n"
      if $VERBOSE >= 2;

   push @index, ((length $pm) << 25) | length $data;
   $data .= $pm . $src;
}

length $data < 2**25
   or die "bundle too large (only 32MB supported)\n";

my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16;

#############################################################################
# output

print "generating $PREFIX.h... ";

{
   open my $fh, ">", "$PREFIX.h"
      or die "$PREFIX.h: $!\n";

   print $fh <<EOF;
/* do not edit, automatically created by mkstaticbundle */
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

/* public API */
EXTERN_C PerlInterpreter *staticperl;
EXTERN_C void staticperl_init (void);
EXTERN_C void staticperl_cleanup (void);
EOF
}

print "\n";

#############################################################################
# output

print "generating $PREFIX.c... ";

open my $fh, ">", "$PREFIX.c"
   or die "$PREFIX.c: $!\n";

print $fh <<EOF;
/* do not edit, automatically created by mkstaticbundle */

#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#include "bundle.h"

/* public API */
PerlInterpreter *staticperl;

EOF

#############################################################################
# bundle data

my $count = @index;

print $fh <<EOF;
#include "bundle.h"

/* bundle data */

static const U32 $varpfx\_count = $count;
static const U32 $varpfx\_index [$count + 1] = {
EOF

my $col;
for (@index) {
   printf $fh "0x%08x,", $_;
   print $fh "\n" unless ++$col % 10;

}
printf $fh "0x%08x\n};\n", (length $data);

print $fh "static const char $varpfx\_data [] =\n";
dump_string $fh, $data;

print $fh ";\n\n";;

#############################################################################
# bootstrap

# boot file for staticperl
# this file will be eval'ed at initialisation time

my $bootstrap = '
BEGIN {
   package ' . $PACKAGE . ';

   PerlIO::scalar->bootstrap;

   @INC = sub {
      my $data = find "$_[1]"
         or return;

      $INC{$_[1]} = $_[1];

      open my $fh, "<", \$data;
      $fh
   };
}
';

$bootstrap .= "require '//boot';"
   if exists $pm{"//boot"};

$bootstrap =~ s/\s+/ /g;
$bootstrap =~ s/(\W) /$1/g;
$bootstrap =~ s/ (\W)/$1/g;

print $fh "const char bootstrap [] = ";
dump_string $fh, $bootstrap;
print $fh ";\n\n";

print $fh <<EOF;
/* search all bundles for the given file, using binary search */
XS(find)
{
  dXSARGS;

  if (items != 1)
    Perl_croak (aTHX_ "Usage: $PACKAGE\::find (\$path)");

  {
    STRLEN namelen;
    char *name = SvPV (ST (0), namelen);
    SV *res = 0;

    int l = 0, r = $varpfx\_count;

    while (l <= r)
      {
        int m = (l + r) >> 1;
        U32 idx = $varpfx\_index [m];
        int comp = namelen - (idx >> 25);

        if (!comp)
          {
            int ofs = idx & 0x1FFFFFFU;
            comp = memcmp (name, $varpfx\_data + ofs, namelen);

            if (!comp)
              {
                /* found */
                int ofs2 =  $varpfx\_index [m + 1] & 0x1FFFFFFU;

                ofs += namelen;
                res = newSVpvn ($varpfx\_data + ofs, ofs2 - ofs);
                goto found;
              }
          }

        if (comp < 0)
          r = m - 1;
        else
          l = m + 1;
      }

    XSRETURN (0);

  found:
    ST (0) = res;
    sv_2mortal (ST (0));
  }

  XSRETURN (1);
}

/* list all files in the bundle */
XS(list)
{
  dXSARGS;

  if (items != 0)
    Perl_croak (aTHX_ "Usage: $PACKAGE\::list");

  {
    int i;

    EXTEND (SP, $varpfx\_count);

    for (i = 0; i < $varpfx\_count; ++i)
      {
        U32 idx = $varpfx\_index [i];

        PUSHs (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25));
      }
  }

  XSRETURN ($varpfx\_count);
}

static char *args[] = {
  "staticperl",
  "-e",
  "0"
};

EOF

#############################################################################
# xs_init

print $fh <<EOF;
static void
xs_init (pTHX)
{
EOF

@static_ext = ("DynaLoader", sort @static_ext);

# prototypes
for (@static_ext) {
   s/\.pm$//;
   (my $cname = $_) =~ s/\//__/g;
   print $fh "  EXTERN_C void boot_$cname (pTHX_ CV* cv);\n";
}

print $fh <<EOF;
  char *file = __FILE__;
  dXSUB_SYS;

  newXSproto ("$PACKAGE\::find", find, file, "\$");
  newXSproto ("$PACKAGE\::list", list, file, "");
EOF

# calls
for (@static_ext) {
   s/\.pm$//;

   (my $cname = $_) =~ s/\//__/g;
   (my $pname = $_) =~ s/\//::/g;

   my $bootstrap = $pname eq "DynaLoader" ? "boot" : "bootstrap";

   print $fh "  newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
}

print $fh <<EOF;
  Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
}
EOF

#############################################################################
# optional perl_init/perl_destroy

if ($PERL) {
   print $fh <<EOF;

int
main (int argc, char *argv [])
{
  extern char **environ;
  int exitstatus;

  PERL_SYS_INIT3 (&argc, &argv, &environ);
  staticperl = perl_alloc ();
  perl_construct (staticperl);

  PL_exit_flags |= PERL_EXIT_DESTRUCT_END;

  exitstatus = perl_parse (staticperl, xs_init, argc, argv, environ);
  if (!exitstatus)
    perl_run (staticperl);

  exitstatus = perl_destruct (staticperl);
  perl_free (staticperl);
  PERL_SYS_TERM ();

  return exitstatus;
}
EOF
} else {
   print $fh <<EOF;

EXTERN_C void
staticperl_init (void)
{
  extern char **environ;
  int argc = sizeof (args) / sizeof (args [0]);
  char **argv = args;

  PERL_SYS_INIT3 (&argc, &argv, &environ);
  staticperl = perl_alloc ();
  perl_construct (staticperl);
  PL_origalen = 1;
  PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
  perl_parse (staticperl, xs_init, argc, argv, environ);

  perl_run (staticperl);
}

EXTERN_C void
staticperl_cleanup (void)
{
  perl_destruct (staticperl);
  perl_free (staticperl);
  staticperl = 0;
  PERL_SYS_TERM ();
}
EOF
}

print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n";

#############################################################################
# libs, cflags

{
   print "generating $PREFIX.ccopts... ";

   my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
   $str =~ s/([\(\)])/\\$1/g;

   print "$str\n\n";

   open my $fh, ">$PREFIX.ccopts"
      or die "$PREFIX.ccopts: $!";
   print $fh $str;
}

{
   print "generating $PREFIX.ldopts... ";

   my $str = $STATIC ? "--static " : "";

   $str .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}";

   my %seen;
   $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g);

   $str =~ s/([\(\)])/\\$1/g;

   print "$str\n\n";

   open my $fh, ">$PREFIX.ldopts"
      or die "$PREFIX.ldopts: $!";
   print $fh $str;
}

if ($PERL) {
   system "$Config{cc} \$(cat bundle.ccopts\) -o perl bundle.c \$(cat bundle.ldopts\)";

   unlink "$PREFIX.$_"
      for qw(ccopts ldopts c h);
}

MKBUNDLE
}

bundle() {
   catmkbundle >"$MKBUNDLE~" || fatal "$MKBUNDLE~: cannot create"
   chmod 755 "$MKBUNDLE~" && mv "$MKBUNDLE~" "$MKBUNDLE"
   "$PREFIX/bin/perl" -- "$MKBUNDLE" "$@"
}

if [ $# -gt 0 ]; then
   while [ $# -gt 0 ]; do
      mkdir -p "$STATICPERL" || fatal "$STATICPERL: cannot create"
      mkdir -p "$PREFIX" || fatal "$PREFIX: cannot create"

      command="${1#--}"; shift
      case "$command" in
         fetch | configure | build | install | clean | distclean)
            verblock <<EOF
$command
EOF
            "$command"
            ;;
         instsrc )
            instsrc "$@"
            exit
            ;;
         instcpan )
            instcpan "$@"
            exit
            ;;
         instschmorp )
            install_schmorp
            ;;
         cpan )
            install
            "$PREFIX/bin/cpan" "$@"
            exit
            ;;
         mkbundle )
            install
            bundle "$@"
            exit
            ;;
         mkperl )
            install
            bundle --perl "$@"
            exit
            ;;
         help )
            podusage 2
            ;;
         * )
            exec 1>&2
            echo
            echo "Unknown command: $command"
            podusage 0
            ;;
      esac
   done
else
   usage
fi

exit 0

=head1 NAME

staticperl - perl, libc, 50 modules all in one 500kb file

=head1 SYNOPSIS

   staticperl help      # print the embedded documentation
   staticperl fetch     # fetch and unpack perl sources
   staticperl configure # fetch and then configure perl
   staticperl build     # configure and then build perl
   staticperl install   # build and then install perl
   staticperl clean     # clean most intermediate files (restart at configure)
   staticperl distclean # delete everything installed by this script
   staticperl cpan      # invoke CPAN shell
   staticperl instmod path...        # install unpacked modules
   staticperl instcpan modulename... # install modules from CPAN
   staticperl mkbundle <bundle-args...> # see documentation
   staticperl mkperl <bundle-args...>   # see documentation

Typical Examples:

   staticperl install   # fetch, configure, build and install perl
   staticperl cpan      # run interactive cpan shell
   staticperl mkperl -M '"Config_heavy.pl"' # build a perl that supports -V
   staticperl mkperl -MAnyEvent::Impl::Perl -MAnyEvent::HTTPD -MURI -MURI::http
                        # build a perl with the above modules linked in

=head1 DESCRIPTION

This script helps you creating single-file perl interpreters, or embedding
a pelr interpreter in your apps. Single-file means that it is fully
self-contained - no separate shared objects, no autoload fragments, no .pm
or .pl files are needed. And when linking statically, you can create (or
embed) a single file that contains perl interpreter, libc, all the modules
you need and all the libraries you need.

With uclibc and upx on x86, you can create a single 500kb binary that
contains perl and 50 modules such as AnyEvent, EV, IO::AIO, Coro and so
on. Or any other choice of modules.

The created files do not need write access to the filesystem (like PAR
does). In fact, since this script is in many ways similar to PAR::Packer,
here are the differences:

=over 4

=item * The generated executables are much smaller than PAR created ones.

Shared objects and the perl binary contain a lot of extra info, while
the static nature of F<staticperl> allows the linker to remove all
functionality and meta-info not required by the final executable. Even
extensions statically compiled into perl at build time will only be
present in the final executable when needed.

In addition, F<staticperl> can strip perl sources much more effectively
than PAR.

=item * The generated executables start much faster.

There is no need to unpack files, or even to parse Zip archives (which is
slow and memory-consuming business).

=item * The generated executables don't need a writable filesystem.

F<staticperl> loads all required files directly from memory. There is no
need to unpack files into a temporary directory.

=item * More control over included files.

PAR tries to be maintainance and hassle-free - it tries to include more files
than necessary to make sure everything works out of the box. The extra files
(such as the unicode database) can take substantial amounts of memory and filesize.

With F<staticperl>, the burden is mostly with the developer - only direct
compile-time dependencies and L<AutoLoader> are handled automatically.
This means the modules to include often need to be tweaked manually.

=item * PAR works out of the box, F<staticperl> does not.

Maintaining your own custom perl build can be a pain in the ass, and while
F<staticperl> tries to make this easy, it still requires a custom perl
build and possibly fiddling with some modules. PAR is likely to produce
results faster.

=back

=head1 HOW DOES IT WORK?

Simple: F<staticperl> downloads, compile and installs a perl version of
your choice in F<~/.staticperl>. You can add extra modules either by
letting F<staticperl> install them for you automatically, or by using CPAN
and doing it interactively. This usually takes 5-10 minutes, depending on
the speed of your computer and your internet conenction.

It is possible to do program development at this stage, too.

Afterwards, you create a list of files and modules you want to include,
and then either build a new perl binary (that acts just like a normla perl
except everything is compiled in), or you create bundle files (basically C
sources you can use to embed all files into your project).

This step is very fast (a few seconds if PPI is not used for stripping,
more seconds otherwise, as PPI is very slow), and can be tweaked and
repeated as often as necessary.

=head1 THE F<STATICPERL> SCRIPT

This module installs a script called F<staticperl> into your perl
binary directory. The script is fully self-contained, and can be used
without perl (for example, in an uClibc chroot environment). In fact,
it can be extracted from the C<App::Staticperl> distribution tarball as
F<bin/staticperl>, without any installation.

F<staticperl> interprets the first argument as a command to execute,
optionally followed by any parameters.

There are two command categories: the "phase 1" commands which deal with
installing perl and perl modules, and the "phase 2" commands, which deal
with creating binaries and bundle files.

=head2 PHASE 1 COMMANDS: INSTALLING PERL

The most important command is F<install>, which does basically
everything. The default is to download and install perl 5.12.2 and a few
modules required by F<staticperl> itself, but all this can (and should) be
changed - see L<CONFIGURATION>, below.

The command

   staticperl install

Is normally all you need: It installs the perl interpreter in
F<~/.staticperl/perl>. It downloads, configures, builds and installs the
perl interpreter if required.

Most of the following commands simply run one or more steps of this
sequence.

To force recompilation or reinstalaltion, you need to run F<staticperl
distclean> first.

=over 4

=item F<staticperl fetch>

Runs only the download and unpack phase, unless this has already happened.

=item F<staticperl configure>

Configures the unpacked perl sources, potentially after downloading them first.

=item F<staticperl build>

Builds the configured perl sources, potentially after automatically
configuring them.

=item F<staticperl install>

Wipes the perl installation directory (usually F<~/.staticperl/perl>) and installs
the perl distribution, potentially aftering building it first.

=item F<staticperl cpan> [args...]

Starts an interactive CPAN shell that you cna use to install further
modules. Installs the perl first if neccessary, but apart from that,
no magic is involved: you could just as well run it manually via
F<~/.staticperl/perl/bin/cpan>.

Any additional arguments are simply passed to the F<cpan> command.

=item F<staticperl instcpan> module...

Tries to install all the modules given and their dependencies, using CPAN.

Example:

   staticperl instcpan EV AnyEvent::HTTPD Coro

=item F<staticperl instsrc> directory...

In the unlikely case that you have unpacked perl modules around and want
to install from these instead of from CPAN, you cna do this using this
command by specifying all the directories with modules in them that you
want to have built.

=item F<staticperl clean>

Runs F<make distclean> in the perl source directory (and potentially
cleans up other intermediate files). This can be used to clean up
intermediate files without removing the installed perl interpreter.

=item F<staticperl distclean>

This wipes your complete F<~/.staticperl> directory. Be careful with this,
it nukes your perl download, perl sources, perl distribution and any
installed modules. It is useful if you wish to start over "from scratch"
or when you want to uninstall F<staticperl>.

=back

=head2 PHASE 2 COMMANDS: BUILDING PERL BUNDLES

Building (linking) a new F<perl> binary is handled by a separate
script. To make it easy to use F<staticperl> from a F<chroot>, the script
is embedded into F<staticperl>, which will write it out and call for you
with any arguments you pass:

   staticperl mkbundle mkbundle-args...

In the oh so unlikely case of something not working here, you
cna run the script manually as well (by default it is written to
F<~/.staticperl/mkbundle>).

F<mkbundle> is a more conventional command and expect the argument
syntax commonly used on unix clones. For example, this command builds
a new F<perl> binary and includes F<Config.pm> (for F<perl -V>),
F<AnyEvent::HTTPD>, F<URI> and a custom F<httpd> script (from F<eg/httpd>
in this distribution):

   # first make sure we have perl and the required modules
   staticperl instcpan AnyEvent::HTTPD

   # now build the perl
   staticperl mkperl -M'"Config_heavy.pl"' -MAnyEvent::Impl::Perl \
                     -MAnyEvent::HTTPD -MURI::http \
                     --add 'eg/httpd httpd.pm'

   # finally, invoke it
   ./perl -Mhttpd

As you can see, things
   

   "strip=s"   => \$STRIP,
   "verbose|v" => sub { ++$VERBOSE },
   "quiet|q"   => sub { --$VERBOSE },
   "perl"      => \$PERL,
   "eval=s"    => sub { trace_eval   $_[1] },
   "use|M=s"   => sub { trace_module $_[1] },
   "boot=s"    => sub { cmd_boot     $_[1] },
   "add=s"     => sub { cmd_add      $_[1] },
   "static"    => sub { $STATIC = 1 },
   "<>"        => sub { cmd_file     $_[1] },

=head2 CONFIGURATION AND HOOKS

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://software.schmorp.de/pkg/staticperl.html


Revision:	1.1
Committed:	Mon Dec 6 19:33:58 2010 UTC (15 years, 9 months ago) by root
Branch:	MAIN
Log Message:	* empty log message *