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     $class_name = s/-/::/g;
 212     my $path = File::Spec->catfile( 'blib', 'lib', split( '::', $class_name ) );
 213     $path .= '.pm';
 214     unless ( -f $path ) {
 215         print qq/Not writing PAR, "$path" doesn't exist\n/;
 216         return 0;
 217     }
 218     print qq/Writing PAR "$par"\n/;
 219     chdir File::Spec->catdir( $root, 'blib' );
 220
 221     my $par_pl = 'par.pl';
 222     unlink $par_pl;
 223
 224     my $version = $Catalyst::VERSION;
 225     my $class   = $class_name;
 226
 227     my $classes = '';
 228     $classes .= "    require $_;\n" for @$CLASSES;
 229
 230     unlink $par_pl;
 231
 232     my $usage = $USAGE || <<"EOF";
 233 Usage:
 234     [parl] $name\[.par] [script] [arguments]
 235
 236   Examples:
 237     parl $name.par $name\_server.pl -r
 238     myapp $name\_cgi.pl
 239 EOF
 240
 241     my $script   = $SCRIPT;
 242     my $tmp_file = IO::File->new("> $par_pl ");
 243     print $tmp_file <<"EOF";
 244 if ( \$ENV{PAR_PROGNAME} ) {
 245     my \$zip = \$PAR::LibCache{\$ENV{PAR_PROGNAME}}
 246         || Archive::Zip->new(__FILE__);
 247     my \$script = '$script';
 248     \$ARGV[0] ||= \$script if \$script;
 249     if ( ( \@ARGV == 0 ) || ( \$ARGV[0] eq '-h' ) || ( \$ARGV[0] eq '-help' )) {
 250         my \@members = \$zip->membersMatching('.*script/.*\.pl');
 251         my \$list = "  Available scripts:\\n";
 252         for my \$member ( \@members ) {
 253             my \$name = \$member->fileName;
 254             \$name =~ /(\\w+\\.pl)\$/;
 255             \$name = \$1;
 256             next if \$name =~ /^main\.pl\$/;
 257             next if \$name =~ /^par\.pl\$/;
 258             \$list .= "    \$name\\n";
 259         }
 260         die <<"END";
 261 $usage
 262 \$list
 263 END
 264     }
 265     my \$file = shift \@ARGV;
 266     \$file =~ s/^.*[\\/\\\\]//;
 267     \$file =~ s/\\.[^.]*\$//i;
 268     my \$member = eval { \$zip->memberNamed("./script/\$file.pl") };
 269     die qq/Can't open perl script "\$file"\n/ unless \$member;
 270     PAR::_run_member( \$member, 1 );
 271 }
 272 else {
 273     require lib;
 274     import lib 'lib';
 275     \$ENV{CATALYST_ENGINE} = '$engine';
 276     require $class;
 277     import $class;
 278     require Catalyst::Helper;
 279     require Catalyst::Test;
 280     require Catalyst::Engine::HTTP;
 281     require Catalyst::Engine::CGI;
 282     require Catalyst::Controller;
 283     require Catalyst::Model;
 284     require Catalyst::View;
 285     require Getopt::Long;
 286     require Pod::Usage;
 287     require Pod::Text;
 288     $classes
 289 }
 290 EOF
 291     $tmp_file->close;
 292
 293     # Create package
 294     local $SIG{__WARN__} = sub { };
 295     open my $olderr, '>&STDERR';
 296     open STDERR, '>', File::Spec->devnull;
 297     my %opt = (
 298         'x' => 1,
 299         'n' => 0,
 300         'o' => $par,
 301         'a' => [ grep( !/par.pl/, glob '.' ) ],
 302         'p' => 1,
 303         'B' => $CORE,
 304         'm' => $MULTIARCH
 305     );
 306     App::Packer::PAR->new(
 307         frontend  => 'Module::ScanDeps',
 308         backend   => 'PAR::Packer',
 309         frontopts => \%opt,
 310         backopts  => \%opt,
 311         args      => ['par.pl'],
 312     )->go;
 313
 314     open STDERR, '>&', $olderr;
 315
 316     unlink $par_pl;
 317     chdir $root;
 318     rmove( File::Spec->catfile( 'blib', $par ), $par );
 319     return 1;
 320 }
 321
 322 =head1 AUTHOR
 323
 324 Sebastian Riedel, C<sri@oook.de>
 325
 326 =head1 LICENSE
 327
 328 This library is free software, you can redistribute it and/or modify it under
 329 the same terms as Perl itself.
 330
 331 =cut
 332
 333 1;