1 | #line 1 |
---|
2 | package Module::Install::Catalyst; |
---|
3 | |
---|
4 | use strict; |
---|
5 | |
---|
6 | our @ISA; |
---|
7 | require Module::Install::Base; |
---|
8 | @ISA = qw/Module::Install::Base/; |
---|
9 | |
---|
10 | use File::Find; |
---|
11 | use FindBin; |
---|
12 | use File::Copy::Recursive 'rcopy'; |
---|
13 | use File::Spec (); |
---|
14 | |
---|
15 | my $SAFETY = 0; |
---|
16 | |
---|
17 | our @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/; |
---|
20 | our @CLASSES = (); |
---|
21 | our $ENGINE = 'CGI'; |
---|
22 | our $CORE = 0; |
---|
23 | our $MULTIARCH = 0; |
---|
24 | our $SCRIPT = ''; |
---|
25 | our $USAGE = ''; |
---|
26 | |
---|
27 | #line 42 |
---|
28 | |
---|
29 | sub catalyst { |
---|
30 | my $self = shift; |
---|
31 | print <<EOF; |
---|
32 | *** Module::Install::Catalyst |
---|
33 | EOF |
---|
34 | $self->catalyst_files; |
---|
35 | $self->catalyst_par; |
---|
36 | print <<EOF; |
---|
37 | *** Module::Install::Catalyst finished. |
---|
38 | EOF |
---|
39 | } |
---|
40 | |
---|
41 | #line 58 |
---|
42 | |
---|
43 | sub 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 | |
---|
67 | sub catalyst_ignore_all { |
---|
68 | my ( $self, $ignore ) = @_; |
---|
69 | @IGNORE = @$ignore; |
---|
70 | } |
---|
71 | |
---|
72 | #line 93 |
---|
73 | |
---|
74 | sub catalyst_ignore { |
---|
75 | my ( $self, @ignore ) = @_; |
---|
76 | push @IGNORE, @ignore; |
---|
77 | } |
---|
78 | |
---|
79 | #line 102 |
---|
80 | |
---|
81 | # Workaround for a namespace conflict |
---|
82 | sub 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); |
---|
93 | catalyst_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# } )" |
---|
95 | EOF |
---|
96 | print <<EOF; |
---|
97 | Please run "make catalyst_par" to create the PAR package! |
---|
98 | EOF |
---|
99 | } |
---|
100 | |
---|
101 | #line 126 |
---|
102 | |
---|
103 | sub catalyst_par_core { |
---|
104 | my ( $self, $core ) = @_; |
---|
105 | $core ? ( $CORE = $core ) : $CORE++; |
---|
106 | } |
---|
107 | |
---|
108 | #line 135 |
---|
109 | |
---|
110 | sub catalyst_par_classes { |
---|
111 | my ( $self, @classes ) = @_; |
---|
112 | push @CLASSES, @classes; |
---|
113 | } |
---|
114 | |
---|
115 | #line 144 |
---|
116 | |
---|
117 | sub catalyst_par_engine { |
---|
118 | my ( $self, $engine ) = @_; |
---|
119 | $ENGINE = $engine; |
---|
120 | } |
---|
121 | |
---|
122 | #line 153 |
---|
123 | |
---|
124 | sub catalyst_par_multiarch { |
---|
125 | my ( $self, $multiarch ) = @_; |
---|
126 | $multiarch ? ( $MULTIARCH = $multiarch ) : $MULTIARCH++; |
---|
127 | } |
---|
128 | |
---|
129 | #line 162 |
---|
130 | |
---|
131 | sub catalyst_par_script { |
---|
132 | my ( $self, $script ) = @_; |
---|
133 | $SCRIPT = $script; |
---|
134 | } |
---|
135 | |
---|
136 | #line 171 |
---|
137 | |
---|
138 | sub catalyst_par_usage { |
---|
139 | my ( $self, $usage ) = @_; |
---|
140 | $USAGE = $usage; |
---|
141 | } |
---|
142 | |
---|
143 | package Catalyst::Module::Install; |
---|
144 | |
---|
145 | use strict; |
---|
146 | use FindBin; |
---|
147 | use File::Copy::Recursive 'rmove'; |
---|
148 | use File::Spec (); |
---|
149 | |
---|
150 | sub _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"; |
---|
199 | Usage: |
---|
200 | [parl] $name\[.par] [script] [arguments] |
---|
201 | |
---|
202 | Examples: |
---|
203 | parl $name.par $name\_server.pl -r |
---|
204 | myapp $name\_cgi.pl |
---|
205 | EOF |
---|
206 | |
---|
207 | my $script = $SCRIPT; |
---|
208 | my $tmp_file = IO::File->new("> $par_pl "); |
---|
209 | print $tmp_file <<"EOF"; |
---|
210 | if ( \$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 |
---|
229 | END |
---|
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 | } |
---|
238 | else { |
---|
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 | } |
---|
256 | EOF |
---|
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 | |
---|
290 | 1; |
---|