TreeOfTexts/inc/Module/Install/Catalyst.pm

   1 #line 1
   2 package Module::Install::Catalyst;
   3
   4 use strict;
   5
   6 our @ISA;
   7 require Module::Install::Base;
   8 @ISA = qw/Module::Install::Base/;
   9
  10 use File::Find;
  11 use FindBin;
  12 use File::Copy::Recursive;
  13 use File::Spec ();
  14 use Getopt::Long ();
  15 use Data::Dumper;
  16
  17 my $SAFETY = 0;
  18
  19 our @IGNORE =
  20   qw/Build Build.PL Changes MANIFEST META.yml Makefile.PL Makefile README
  21   _build blib lib script t inc .*\.svn \.git _darcs \.bzr \.hg
  22   debian build-stamp install-stamp configure-stamp/;
  23 our @CLASSES   = ();
  24 our $ENGINE    = 'CGI';
  25 our $SCRIPT    = '';
  26 our $USAGE     = '';
  27 our %PAROPTS   = ();
  28
  29 #line 57
  30
  31 sub catalyst {
  32     my $self = shift;
  33
  34     if($Module::Install::AUTHOR) {
  35         $self->include("File::Copy::Recursive");
  36     }
  37
  38     print <<EOF;
  39 *** Module::Install::Catalyst
  40 EOF
  41     $self->catalyst_files;
  42     $self->catalyst_par;
  43     print <<EOF;
  44 *** Module::Install::Catalyst finished.
  45 EOF
  46 }
  47
  48 #line 82
  49
  50 sub catalyst_files {
  51     my $self = shift;
  52
  53     chdir $FindBin::Bin;
  54
  55     my @files;
  56     opendir CATDIR, '.';
  57   CATFILES: for my $name ( readdir CATDIR ) {
  58         for my $ignore (@IGNORE) {
  59             next CATFILES if $name =~ /^$ignore$/;
  60             next CATFILES if $name !~ /\w/;
  61         }
  62         push @files, $name;
  63     }
  64     closedir CATDIR;
  65     my @path = split '-', $self->name;
  66     for my $orig (@files) {
  67         my $path = File::Spec->catdir( 'blib', 'lib', @path, $orig );
  68         File::Copy::Recursive::rcopy( $orig, $path );
  69     }
  70 }
  71
  72 #line 110
  73
  74 sub catalyst_ignore_all {
  75     my ( $self, $ignore ) = @_;
  76     @IGNORE = @$ignore;
  77 }
  78
  79 #line 121
  80
  81 sub catalyst_ignore {
  82     my ( $self, @ignore ) = @_;
  83     push @IGNORE, @ignore;
  84 }
  85
  86 #line 130
  87
  88 # Workaround for a namespace conflict
  89 sub catalyst_par {
  90     my ( $self, $par ) = @_;
  91     $par ||= '';
  92     return if $SAFETY;
  93     $SAFETY++;
  94     my $name  = $self->name;
  95     my $usage = $USAGE;
  96     $usage =~ s/"/\\"/g;
  97     my $class_string = join "', '", @CLASSES;
  98     $class_string = "'$class_string'" if $class_string;
  99     local $Data::Dumper::Indent = 0;
 100     local $Data::Dumper::Terse = 1;
 101     local $Data::Dumper::Pad = ' ';
 102     my $paropts_string = Dumper(\%PAROPTS) || "{ }";
 103     $self->postamble(<<EOF);
 104 catalyst_par :: all
 105 \t\$(NOECHO) \$(PERL) -Ilib -Minc::Module::Install -MModule::Install::Catalyst -e"Catalyst::Module::Install::_catalyst_par( '$par', '$name', { CLASSES => [$class_string], PAROPTS => $paropts_string, ENGINE => '$ENGINE', SCRIPT => '$SCRIPT', USAGE => q#$usage# } )"
 106 EOF
 107     print <<EOF;
 108 Please run "make catalyst_par" to create the PAR package!
 109 EOF
 110 }
 111
 112 #line 158
 113
 114 sub catalyst_par_core {
 115     my ( $self, $core ) = @_;
 116     $core ? ( $PAROPTS{'B'} = $core ) : $PAROPTS{'B'}++;
 117 }
 118
 119 #line 167
 120
 121 sub catalyst_par_classes {
 122     my ( $self, @classes ) = @_;
 123     push @CLASSES, @classes;
 124 }
 125
 126 #line 176
 127
 128 sub catalyst_par_engine {
 129     my ( $self, $engine ) = @_;
 130     $ENGINE = $engine;
 131 }
 132
 133 #line 185
 134
 135 sub catalyst_par_multiarch {
 136     my ( $self, $multiarch ) = @_;
 137     $multiarch ? ( $PAROPTS{'m'} = $multiarch ) : $PAROPTS{'m'}++;
 138 }
 139
 140 #line 218
 141
 142 sub catalyst_par_options {
 143     my ( $self, $optstring ) = @_;
 144     eval "use PAR::Packer ()";
 145     if ($@) {
 146         warn "WARNING: catalyst_par_options ignored - you need PAR::Packer\n"
 147     }
 148     else {
 149         my $p = Getopt::Long::Parser->new(config => ['no_ignore_case']);
 150         my %o;
 151         require Text::ParseWords;
 152         {
 153             local @ARGV = Text::ParseWords::shellwords($optstring);
 154             $p->getoptions(\%o, PAR::Packer->options);
 155         }
 156         %PAROPTS = ( %PAROPTS, %o);
 157     }
 158 }
 159
 160 #line 240
 161
 162 sub catalyst_par_script {
 163     my ( $self, $script ) = @_;
 164     $SCRIPT = $script;
 165 }
 166
 167 #line 249
 168
 169 sub catalyst_par_usage {
 170     my ( $self, $usage ) = @_;
 171     $USAGE = $usage;
 172 }
 173
 174 package Catalyst::Module::Install;
 175
 176 use strict;
 177 use FindBin;
 178 use File::Copy::Recursive 'rmove';
 179 use File::Spec ();
 180
 181 sub _catalyst_par {
 182     my ( $par, $class_name, $opts ) = @_;
 183
 184     my $ENGINE    = $opts->{ENGINE};
 185     my $CLASSES   = $opts->{CLASSES} || [];
 186     my $USAGE     = $opts->{USAGE};
 187     my $SCRIPT    = $opts->{SCRIPT};
 188     my $PAROPTS   = $opts->{PAROPTS};
 189
 190     my $name = $class_name;
 191     $name =~ s/::/_/g;
 192     $name = lc $name;
 193     $par ||= "$name.par";
 194     my $engine = $ENGINE || 'CGI';
 195
 196     # Check for PAR
 197     eval "use PAR ()";
 198     die "Please install PAR\n" if $@;
 199     eval "use PAR::Packer ()";
 200     die "Please install PAR::Packer\n" if $@;
 201     eval "use App::Packer::PAR ()";
 202     die "Please install App::Packer::PAR\n" if $@;
 203     eval "use Module::ScanDeps ()";
 204     die "Please install Module::ScanDeps\n" if $@;
 205
 206     my $root = $FindBin::Bin;
 207     $class_name =~ s/-/::/g;
 208     my $path = File::Spec->catfile( 'blib', 'lib', split( '::', $class_name ) );
 209     $path .= '.pm';
 210     unless ( -f $path ) {
 211         print qq/Not writing PAR, "$path" doesn't exist\n/;
 212         return 0;
 213     }
 214     print qq/Writing PAR "$par"\n/;
 215     chdir File::Spec->catdir( $root, 'blib' );
 216
 217     my $par_pl = 'par.pl';
 218     unlink $par_pl;
 219
 220     my $version = $Catalyst::VERSION;
 221     my $class   = $class_name;
 222
 223     my $classes = '';
 224     $classes .= "    require $_;\n" for @$CLASSES;
 225
 226     unlink $par_pl;
 227
 228     my $usage = $USAGE || <<"EOF";
 229 Usage:
 230     [parl] $name\[.par] [script] [arguments]
 231
 232   Examples:
 233     parl $name.par $name\_server.pl -r
 234     myapp $name\_cgi.pl
 235 EOF
 236
 237     my $script   = $SCRIPT;
 238     my $tmp_file = IO::File->new("> $par_pl ");
 239     print $tmp_file <<"EOF";
 240 if ( \$ENV{PAR_PROGNAME} ) {
 241     my \$zip = \$PAR::LibCache{\$ENV{PAR_PROGNAME}}
 242         || Archive::Zip->new(__FILE__);
 243     my \$script = '$script';
 244     \$ARGV[0] ||= \$script if \$script;
 245     if ( ( \@ARGV == 0 ) || ( \$ARGV[0] eq '-h' ) || ( \$ARGV[0] eq '-help' )) {
 246         my \@members = \$zip->membersMatching('.*script/.*\.pl');
 247         my \$list = "  Available scripts:\\n";
 248         for my \$member ( \@members ) {
 249             my \$name = \$member->fileName;
 250             \$name =~ /(\\w+\\.pl)\$/;
 251             \$name = \$1;
 252             next if \$name =~ /^main\.pl\$/;
 253             next if \$name =~ /^par\.pl\$/;
 254             \$list .= "    \$name\\n";
 255         }
 256         die <<"END";
 257 $usage
 258 \$list
 259 END
 260     }
 261     my \$file = shift \@ARGV;
 262     \$file =~ s/^.*[\\/\\\\]//;
 263     \$file =~ s/\\.[^.]*\$//i;
 264     my \$member = eval { \$zip->memberNamed("./script/\$file.pl") };
 265     die qq/Can't open perl script "\$file"\n/ unless \$member;
 266     PAR::_run_member( \$member, 1 );
 267 }
 268 else {
 269     require lib;
 270     import lib 'lib';
 271     \$ENV{CATALYST_ENGINE} = '$engine';
 272     require $class;
 273     import $class;
 274     require Catalyst::Helper;
 275     require Catalyst::Test;
 276     require Catalyst::Engine::HTTP;
 277     require Catalyst::Engine::CGI;
 278     require Catalyst::Controller;
 279     require Catalyst::Model;
 280     require Catalyst::View;
 281     require Getopt::Long;
 282     require Pod::Usage;
 283     require Pod::Text;
 284     $classes
 285 }
 286 EOF
 287     $tmp_file->close;
 288
 289     # Create package
 290     local $SIG{__WARN__} = sub { };
 291     open my $olderr, '>&STDERR';
 292     open STDERR, '>', File::Spec->devnull;
 293     my %opt = (
 294         %{$PAROPTS},
 295         # take user defined options first and override them with harcoded defaults
 296         'x' => 1,
 297         'n' => 0,
 298         'o' => $par,
 299         'p' => 1,
 300     );
 301     # do not replace the whole $opt{'a'} array; just push required default value
 302     push @{$opt{'a'}}, grep( !/par.pl/, glob '.' );
 303
 304     App::Packer::PAR->new(
 305         frontend  => 'Module::ScanDeps',
 306         backend   => 'PAR::Packer',
 307         frontopts => \%opt,
 308         backopts  => \%opt,
 309         args      => ['par.pl'],
 310     )->go;
 311
 312     open STDERR, '>&', $olderr;
 313
 314     unlink $par_pl;
 315     chdir $root;
 316     rmove( File::Spec->catfile( 'blib', $par ), $par );
 317     return 1;
 318 }
 319
 320 #line 411
 321
 322 1;