lib/Module/Install/Catalyst.pm

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