[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
  debian build-stamp install-stamp configure-stamp/;
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
  
  use inc::Module::Install;
  
  name 'MyApp';
  all_from 'lib/MyApp.pm';
  
  requires 'Catalyst::Runtime' => '5.7014';
  
  catalyst_ignore('.*temp');
  catalyst_ignore('.*tmp');
  catalyst;
  WriteAll;

=head1 DESCRIPTION

L<Module::Install> extension for Catalyst.

=head1 METHODS

=head2 catalyst

Calls L<catalyst_files> and L<catalyst_par>. Should be the last catalyst*
command called in C<Makefile.PL>.

=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

Collect a list of all files a Catalyst application consists of and copy it  
inside the blib/lib/ directory. Files and directories that match the modules 
ignore list are excluded (see L<catalyst_ignore> and L<catalyst_ignore_all>).

=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)

This function replaces the built-in default ignore list with the given list.

=cut

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

=head2 catalyst_ignore(\@ignore)

Add a regexp to the list of ignored patterns. Can be called multiple times.

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