source: LATMOS-Accounts-Web/inc/Module/Install/Catalyst.pm @ 437

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