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     print <<EOF;
  47 *** Module::Install::Catalyst
  48 EOF
  49     $self->catalyst_files;
  50     $self->catalyst_par;
  51     print <<EOF;
  52 *** Module::Install::Catalyst finished.
  53 EOF
  54 }
  55
  56 =head2 catalyst_files
  57
  58 =cut
  59
  60 sub catalyst_files {
  61     my $self = shift;
  62
  63     chdir $FindBin::Bin;
  64
  65     my @files;
  66     opendir CATDIR, '.';
  67   CATFILES: for my $name ( readdir CATDIR ) {
  68         for my $ignore (@IGNORE) {
  69             next CATFILES if $name =~ /^$ignore$/;
  70             next CATFILES if $name !~ /\w/;
  71         }
  72         push @files, $name;
  73     }
  74     closedir CATDIR;
  75     my @path = split '-', $self->name;
  76     for my $orig (@files) {
  77         my $path = File::Spec->catdir( 'blib', 'lib', @path, $orig );
  78         rcopy( $orig, $path );
  79     }
  80 }
  81
  82 =head2 catalyst_ignore_all(\@ignore)
  83
  84 =cut
  85
  86 sub catalyst_ignore_all {
  87     my ( $self, $ignore ) = @_;
  88     @IGNORE = @$ignore;
  89 }
  90
  91 =head2 catalyst_ignore(\@ignore)
  92
  93 =cut
  94
  95 sub catalyst_ignore {
  96     my ( $self, @ignore ) = @_;
  97     push @IGNORE, @ignore;
  98 }
  99
 100 =head2 catalyst_par($name)
 101
 102 =cut
 103
 104 # Workaround for a namespace conflict
 105 sub catalyst_par {
 106     my ( $self, $par ) = @_;
 107     return if $SAFETY;
 108     $SAFETY++;
 109     my $name  = $self->name;
 110     my $usage = $USAGE;
 111     $usage =~ s/"/\\"/g;
 112     my $class_string = join "', '", @CLASSES;
 113     $class_string = "'$class_string'" if $class_string;
 114     $self->postamble(<<EOF);
 115 catalyst_par :: all
 116 \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# } )"
 117 EOF
 118     print <<EOF;
 119 Please run "make catalyst_par" to create the PAR package!
 120 EOF
 121 }
 122
 123 =head2 catalyst_par_core($core)
 124
 125 =cut
 126
 127 sub catalyst_par_core {
 128     my ( $self, $core ) = @_;
 129     $core ? ( $CORE = $core ) : $CORE++;
 130 }
 131
 132 =head2 catalyst_par_classes(@clases)
 133
 134 =cut
 135
 136 sub catalyst_par_classes {
 137     my ( $self, @classes ) = @_;
 138     push @CLASSES, @classes;
 139 }
 140
 141 =head2 catalyst_par_engine($engine)
 142
 143 =cut
 144
 145 sub catalyst_par_engine {
 146     my ( $self, $engine ) = @_;
 147     $ENGINE = $engine;
 148 }
 149
 150 =head2 catalyst_par_multiarch($multiarch)
 151
 152 =cut
 153
 154 sub catalyst_par_multiarch {
 155     my ( $self, $multiarch ) = @_;
 156     $multiarch ? ( $MULTIARCH = $multiarch ) : $MULTIARCH++;
 157 }
 158
 159 =head2 catalyst_par_script($script)
 160
 161 =cut
 162
 163 sub catalyst_par_script {
 164     my ( $self, $script ) = @_;
 165     $SCRIPT = $script;
 166 }
 167
 168 =head2 catalyst_par_usage($usage)
 169
 170 =cut
 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 $MULTIARCH = $opts->{MULTIARCH};
 192     my $CORE      = $opts->{CORE};
 193
 194     my $name = $class_name;
 195     $name =~ s/::/_/g;
 196     $name = lc $name;
 197     $par ||= "$name.par";
 198     my $engine = $ENGINE || 'CGI';
 199
 200     # Check for PAR
 201     eval "use PAR ()";
 202     die "Please install PAR\n" if $@;
 203     eval "use PAR::Packer ()";
 204     die "Please install PAR::Packer\n" if $@;
 205     eval "use App::Packer::PAR ()";
 206     die "Please install App::Packer::PAR\n" if $@;
 207     eval "use Module::ScanDeps ()";
 208     die "Please install Module::ScanDeps\n" if $@;
 209
 210     my $root = $FindBin::Bin;
 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         'x' => 1,
 298         'n' => 0,
 299         'o' => $par,
 300         'a' => [ grep( !/par.pl/, glob '.' ) ],
 301         'p' => 1,
 302         'B' => $CORE,
 303         'm' => $MULTIARCH
 304     );
 305     App::Packer::PAR->new(
 306         frontend  => 'Module::ScanDeps',
 307         backend   => 'PAR::Packer',
 308         frontopts => \%opt,
 309         backopts  => \%opt,
 310         args      => ['par.pl'],
 311     )->go;
 312
 313     open STDERR, '>&', $olderr;
 314
 315     unlink $par_pl;
 316     chdir $root;
 317     rmove( File::Spec->catfile( 'blib', $par ), $par );
 318     return 1;
 319 }
 320
 321 =head1 AUTHOR
 322
 323 Sebastian Riedel, C<sri@oook.de>
 324
 325 =head1 LICENSE
 326
 327 This library is free software, you can redistribute it and/or modify it under
 328 the same terms as Perl itself.
 329
 330 =cut
 331
 332 1;