lib/Module/Install/Catalyst.pm

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