[catagits/Catalyst-Devel.git] / lib / Module / Install / Catalyst.pm

package Module::Install::Catalyst;

use strict;

our @ISA;
require Module::Install::Base;
@ISA = qw/Module::Install::Base/;

use File::Find;
use FindBin;
use File::Copy::Recursive 'rcopy';
use File::Spec ();

my $SAFETY = 0;

our @IGNORE =
  qw/Build Build.PL Changes MANIFEST META.yml Makefile.PL Makefile README
  _build blib lib script t inc \.svn \.git _darcs \.bzr \.hg/;
our @CLASSES   = ();
our $ENGINE    = 'CGI';
our $CORE      = 0;
our $MULTIARCH = 0;
our $SCRIPT    = '';
our $USAGE     = '';

=head1 NAME

Module::Install::Catalyst - Module::Install extension for Catalyst

=head1 SYNOPSIS

See L<Catalyst>

=head1 DESCRIPTION

L<Module::Install> extension for Catalyst.

=head1 METHODS

=head2 catalyst

=cut

sub catalyst {
    my $self = shift;
    print <<EOF;
*** Module::Install::Catalyst
EOF
    $self->catalyst_files;
    $self->catalyst_par;
    print <<EOF;
*** Module::Install::Catalyst finished.
EOF
}

=head2 catalyst_files

=cut

sub catalyst_files {
    my $self = shift;

    chdir $FindBin::Bin;

    my @files;
    opendir CATDIR, '.';
  CATFILES: for my $name ( readdir CATDIR ) {
        for my $ignore (@IGNORE) {
            next CATFILES if $name =~ /^$ignore$/;
            next CATFILES if $name !~ /\w/;
        }
        push @files, $name;
    }
    closedir CATDIR;
    my @path = split '-', $self->name;
    for my $orig (@files) {
        my $path = File::Spec->catdir( 'blib', 'lib', @path, $orig );
        rcopy( $orig, $path );
    }
}

=head2 catalyst_ignore_all(\@ignore)

=cut

sub catalyst_ignore_all {
    my ( $self, $ignore ) = @_;
    @IGNORE = @$ignore;
}

=head2 catalyst_ignore(\@ignore)

=cut

sub catalyst_ignore {
    my ( $self, @ignore ) = @_;
    push @IGNORE, @ignore;
}

=head2 catalyst_par($name)

=cut

# Workaround for a namespace conflict
sub catalyst_par {
    my ( $self, $par ) = @_;
    $par ||= '';
    return if $SAFETY;
    $SAFETY++;
    my $name  = $self->name;
    my $usage = $USAGE;
    $usage =~ s/"/\\"/g;
    my $class_string = join "', '", @CLASSES;
    $class_string = "'$class_string'" if $class_string;
    $self->postamble(<<EOF);
catalyst_par :: all
\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# } )"
EOF
    print <<EOF;
Please run "make catalyst_par" to create the PAR package!
EOF
}

=head2 catalyst_par_core($core)

=cut

sub catalyst_par_core {
    my ( $self, $core ) = @_;
    $core ? ( $CORE = $core ) : $CORE++;
}

=head2 catalyst_par_classes(@clases)

=cut

sub catalyst_par_classes {
    my ( $self, @classes ) = @_;
    push @CLASSES, @classes;
}

=head2 catalyst_par_engine($engine)

=cut

sub catalyst_par_engine {
    my ( $self, $engine ) = @_;
    $ENGINE = $engine;
}

=head2 catalyst_par_multiarch($multiarch)

=cut

sub catalyst_par_multiarch {
    my ( $self, $multiarch ) = @_;
    $multiarch ? ( $MULTIARCH = $multiarch ) : $MULTIARCH++;
}

=head2 catalyst_par_script($script)

=cut

sub catalyst_par_script {
    my ( $self, $script ) = @_;
    $SCRIPT = $script;
}

=head2 catalyst_par_usage($usage)

=cut

sub catalyst_par_usage {
    my ( $self, $usage ) = @_;
    $USAGE = $usage;
}

package Catalyst::Module::Install;

use strict;
use FindBin;
use File::Copy::Recursive 'rmove';
use File::Spec ();

sub _catalyst_par {
    my ( $par, $class_name, $opts ) = @_;

    my $ENGINE    = $opts->{ENGINE};
    my $CLASSES   = $opts->{CLASSES} || [];
    my $USAGE     = $opts->{USAGE};
    my $SCRIPT    = $opts->{SCRIPT};
    my $MULTIARCH = $opts->{MULTIARCH};
    my $CORE      = $opts->{CORE};

    my $name = $class_name;
    $name =~ s/::/_/g;
    $name = lc $name;
    $par ||= "$name.par";
    my $engine = $ENGINE || 'CGI';

    # Check for PAR
    eval "use PAR ()";
    die "Please install PAR\n" if $@;
    eval "use PAR::Packer ()";
    die "Please install PAR::Packer\n" if $@;
    eval "use App::Packer::PAR ()";
    die "Please install App::Packer::PAR\n" if $@;
    eval "use Module::ScanDeps ()";
    die "Please install Module::ScanDeps\n" if $@;

    my $root = $FindBin::Bin;
    $class_name =~ s/-/::/g;
    my $path = File::Spec->catfile( 'blib', 'lib', split( '::', $class_name ) );
    $path .= '.pm';
    unless ( -f $path ) {
        print qq/Not writing PAR, "$path" doesn't exist\n/;
        return 0;
    }
    print qq/Writing PAR "$par"\n/;
    chdir File::Spec->catdir( $root, 'blib' );

    my $par_pl = 'par.pl';
    unlink $par_pl;

    my $version = $Catalyst::VERSION;
    my $class   = $class_name;

    my $classes = '';
    $classes .= "    require $_;\n" for @$CLASSES;

    unlink $par_pl;

    my $usage = $USAGE || <<"EOF";
Usage:
    [parl] $name\[.par] [script] [arguments]

  Examples:
    parl $name.par $name\_server.pl -r
    myapp $name\_cgi.pl
EOF

    my $script   = $SCRIPT;
    my $tmp_file = IO::File->new("> $par_pl ");
    print $tmp_file <<"EOF";
if ( \$ENV{PAR_PROGNAME} ) {
    my \$zip = \$PAR::LibCache{\$ENV{PAR_PROGNAME}}
        || Archive::Zip->new(__FILE__);
    my \$script = '$script';
    \$ARGV[0] ||= \$script if \$script;
    if ( ( \@ARGV == 0 ) || ( \$ARGV[0] eq '-h' ) || ( \$ARGV[0] eq '-help' )) {
        my \@members = \$zip->membersMatching('.*script/.*\.pl');
        my \$list = "  Available scripts:\\n";
        for my \$member ( \@members ) {
            my \$name = \$member->fileName;
            \$name =~ /(\\w+\\.pl)\$/;
            \$name = \$1;
            next if \$name =~ /^main\.pl\$/;
            next if \$name =~ /^par\.pl\$/;
            \$list .= "    \$name\\n";
        }
        die <<"END";
$usage
\$list
END
    }
    my \$file = shift \@ARGV;
    \$file =~ s/^.*[\\/\\\\]//;
    \$file =~ s/\\.[^.]*\$//i;
    my \$member = eval { \$zip->memberNamed("./script/\$file.pl") };
    die qq/Can't open perl script "\$file"\n/ unless \$member;
    PAR::_run_member( \$member, 1 );
}
else {
    require lib;
    import lib 'lib';
    \$ENV{CATALYST_ENGINE} = '$engine';
    require $class;
    import $class;
    require Catalyst::Helper;
    require Catalyst::Test;
    require Catalyst::Engine::HTTP;
    require Catalyst::Engine::CGI;
    require Catalyst::Controller;
    require Catalyst::Model;
    require Catalyst::View;
    require Getopt::Long;
    require Pod::Usage;
    require Pod::Text;
    $classes
}
EOF
    $tmp_file->close;

    # Create package
    local $SIG{__WARN__} = sub { };
    open my $olderr, '>&STDERR';
    open STDERR, '>', File::Spec->devnull;
    my %opt = (
        'x' => 1,
        'n' => 0,
        'o' => $par,
        'a' => [ grep( !/par.pl/, glob '.' ) ],
        'p' => 1,
        'B' => $CORE,
        'm' => $MULTIARCH
    );
    App::Packer::PAR->new(
        frontend  => 'Module::ScanDeps',
        backend   => 'PAR::Packer',
        frontopts => \%opt,
        backopts  => \%opt,
        args      => ['par.pl'],
    )->go;

    open STDERR, '>&', $olderr;

    unlink $par_pl;
    chdir $root;
    rmove( File::Spec->catfile( 'blib', $par ), $par );
    return 1;
}

=head1 AUTHORS

Catalyst Contributors, see Catalyst.pm

=head1 LICENSE

This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;
Commit	Line	Data
134481a2	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
97e60aa4	18	_build blib lib script t inc \.svn \.git _darcs \.bzr \.hg/;
134481a2	19	our @CLASSES = ();
	20	our $ENGINE = 'CGI';
	21	our $CORE = 0;
	22	our $MULTIARCH = 0;
2f7a957f	23	our $SCRIPT = '';
2f7a957f	24	our $USAGE = '';
134481a2	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 ) = @_;
2f7a957f	107	$par \|\|= '';
134481a2	108	return if $SAFETY;
	109	$SAFETY++;
	110	my $name = $self->name;
	111	my $usage = $USAGE;
	112	$usage =~ s/"/\\"/g;
	113	my $class_string = join "', '", @CLASSES;
	114	$class_string = "'$class_string'" if $class_string;
	115	$self->postamble(<<EOF);
	116	catalyst_par :: all
	117	\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# } )"
	118	EOF
	119	print <<EOF;
	120	Please run "make catalyst_par" to create the PAR package!
	121	EOF
	122	}
	123
	124	=head2 catalyst_par_core($core)
	125
	126	=cut
	127
	128	sub catalyst_par_core {
	129	my ( $self, $core ) = @_;
	130	$core ? ( $CORE = $core ) : $CORE++;
	131	}
	132
	133	=head2 catalyst_par_classes(@clases)
	134
	135	=cut
	136
	137	sub catalyst_par_classes {
	138	my ( $self, @classes ) = @_;
	139	push @CLASSES, @classes;
	140	}
	141
	142	=head2 catalyst_par_engine($engine)
	143
	144	=cut
	145
	146	sub catalyst_par_engine {
	147	my ( $self, $engine ) = @_;
	148	$ENGINE = $engine;
	149	}
	150
	151	=head2 catalyst_par_multiarch($multiarch)
	152
	153	=cut
	154
	155	sub catalyst_par_multiarch {
	156	my ( $self, $multiarch ) = @_;
	157	$multiarch ? ( $MULTIARCH = $multiarch ) : $MULTIARCH++;
	158	}
	159
	160	=head2 catalyst_par_script($script)
	161
	162	=cut
	163
	164	sub catalyst_par_script {
	165	my ( $self, $script ) = @_;
	166	$SCRIPT = $script;
	167	}
	168
	169	=head2 catalyst_par_usage($usage)
	170
	171	=cut
172
173	sub catalyst_par_usage {
174	my ( $self, $usage ) = @_;
175	$USAGE = $usage;
176	}
177
178	package Catalyst::Module::Install;
179
180	use strict;
181	use FindBin;
182	use File::Copy::Recursive 'rmove';
183	use File::Spec ();
184
185	sub _catalyst_par {
186	my ( $par, $class_name, $opts ) = @_;
187
188	my $ENGINE = $opts->{ENGINE};
189	my $CLASSES = $opts->{CLASSES} \|\| [];
190	my $USAGE = $opts->{USAGE};
191	my $SCRIPT = $opts->{SCRIPT};
192	my $MULTIARCH = $opts->{MULTIARCH};
193	my $CORE = $opts->{CORE};
194
195	my $name = $class_name;
196	$name =~ s/::/_/g;
197	$name = lc $name;
198	$par \|\|= "$name.par";
199	my $engine = $ENGINE \|\| 'CGI';
200
201	# Check for PAR
202	eval "use PAR ()";
203	die "Please install PAR\n" if $@;
204	eval "use PAR::Packer ()";
205	die "Please install PAR::Packer\n" if $@;
206	eval "use App::Packer::PAR ()";
207	die "Please install App::Packer::PAR\n" if $@;
208	eval "use Module::ScanDeps ()";
209	die "Please install Module::ScanDeps\n" if $@;
210
211	my $root = $FindBin::Bin;
212	$class_name =~ s/-/::/g;
213	my $path = File::Spec->catfile( 'blib', 'lib', split( '::', $class_name ) );
214	$path .= '.pm';
215	unless ( -f $path ) {
216	print qq/Not writing PAR, "$path" doesn't exist\n/;
217	return 0;
218	}
219	print qq/Writing PAR "$par"\n/;
220	chdir File::Spec->catdir( $root, 'blib' );
221
222	my $par_pl = 'par.pl';
223	unlink $par_pl;
224
225	my $version = $Catalyst::VERSION;
226	my $class = $class_name;
227
228	my $classes = '';
229	$classes .= " require $_;\n" for @$CLASSES;
230
231	unlink $par_pl;
232
233	my $usage = $USAGE \|\| <<"EOF";
234	Usage:
235	[parl] $name\[.par] [script] [arguments]
236
237	Examples:
238	parl $name.par $name\_server.pl -r
239	myapp $name\_cgi.pl
240	EOF
241
242	my $script = $SCRIPT;
243	my $tmp_file = IO::File->new("> $par_pl ");
244	print $tmp_file <<"EOF";
245	if ( \$ENV{PAR_PROGNAME} ) {
246	my \$zip = \$PAR::LibCache{\$ENV{PAR_PROGNAME}}
247	\|\| Archive::Zip->new(__FILE__);
248	my \$script = '$script';
249	\$ARGV[0] \|\|= \$script if \$script;
250	if ( ( \@ARGV == 0 ) \|\| ( \$ARGV[0] eq '-h' ) \|\| ( \$ARGV[0] eq '-help' )) {
251	my \@members = \$zip->membersMatching('.script/.\.pl');
252	my \$list = " Available scripts:\\n";
253	for my \$member ( \@members ) {
254	my \$name = \$member->fileName;
255	\$name =~ /(\\w+\\.pl)\$/;
256	\$name = \$1;
257	next if \$name =~ /^main\.pl\$/;
258	next if \$name =~ /^par\.pl\$/;
259	\$list .= " \$name\\n";
260	}
261	die <<"END";
262	$usage
263	\$list
264	END
265	}
266	my \$file = shift \@ARGV;
267	\$file =~ s/^.*[\\/\\\\]//;
268	\$file =~ s/\\.[^.]*\$//i;
269	my \$member = eval { \$zip->memberNamed("./script/\$file.pl") };
270	die qq/Can't open perl script "\$file"\n/ unless \$member;
271	PAR::_run_member( \$member, 1 );
272	}
273	else {
274	require lib;
275	import lib 'lib';
276	\$ENV{CATALYST_ENGINE} = '$engine';
277	require $class;
278	import $class;
279	require Catalyst::Helper;
280	require Catalyst::Test;
281	require Catalyst::Engine::HTTP;
282	require Catalyst::Engine::CGI;
283	require Catalyst::Controller;
284	require Catalyst::Model;
285	require Catalyst::View;
286	require Getopt::Long;
287	require Pod::Usage;
288	require Pod::Text;
289	$classes
290	}
291	EOF
292	$tmp_file->close;
293
294	# Create package
295	local $SIG{__WARN__} = sub { };
296	open my $olderr, '>&STDERR';
297	open STDERR, '>', File::Spec->devnull;
298	my %opt = (
299	'x' => 1,
300	'n' => 0,
301	'o' => $par,
302	'a' => [ grep( !/par.pl/, glob '.' ) ],
303	'p' => 1,
304	'B' => $CORE,
305	'm' => $MULTIARCH
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
cb536e7b	323	=head1 AUTHORS
134481a2	324
cb536e7b	325	Catalyst Contributors, see Catalyst.pm
134481a2	326
	327	=head1 LICENSE
	328
7cd3b67e	329	This library is free software. You can redistribute it and/or modify it under
134481a2	330	the same terms as Perl itself.
	331
	332	=cut
	333
	334	1;