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