Commit | Line | Data |
4536f655 |
1 | package BuildStem ; |
2 | |
3 | use strict; |
4 | use warnings qw( all ); |
5 | |
6 | use Carp ; |
7 | use Config; |
8 | use File::Path ; |
9 | use File::Spec ; |
10 | |
11 | use lib 'lib' ; |
12 | use base 'Module::Build' ; |
13 | |
14 | $ENV{HARNESS_DEBUG} = 1 ; |
15 | $ENV{HARNESS_VERBOSE} = 1 ; |
16 | |
17 | # this is the common env values to control running stem stuff in the |
18 | # build directory. |
19 | |
20 | my $env = |
21 | 'PATH=blib/bin:blib/demo:$PATH PERL5LIB=blib/lib STEM_CONF_PATH=conf' ; |
22 | |
23 | my %env = ( |
24 | PATH => "blib/bin:blib/demo:$ENV{PATH}", |
25 | PERL5LIB => 'blib/lib', |
26 | STEM_CONF_PATH => 'conf', |
27 | ) ; |
28 | |
29 | local( @ENV{ keys %env } ) = values %env ; |
30 | |
31 | |
32 | my ( @manifest_lines ) ; |
33 | |
34 | eval { |
35 | require Stem::InstallConfig |
36 | } ; |
37 | my $conf = \%Stem::InstallConfig::Config ; |
38 | |
39 | my $is_win32 = ( $^O =~ /Win32/) ? 1 : 0 ; |
40 | |
41 | my $default_stem_path = $is_win32 ? |
42 | '/stem' : |
43 | File::Spec->catfile( |
44 | File::Spec->rootdir, qw( usr local stem ) ) ; |
45 | |
46 | my $default_conf_path = File::Spec->catfile( $default_stem_path, 'conf' ) ; |
47 | #my $default_tail_dir = File::Spec->catfile( File::Spec->tmpdir, 'stem_tail' ); |
48 | |
49 | my %defaults = ( |
50 | bin_path => $Config{bin}, |
51 | run_stem_path => File::Spec->catfile( $Config{bin}, 'run_stem' ), |
52 | perl_path => $Config{perlpath}, |
53 | conf_path => $default_conf_path, |
54 | prefix => $Config{prefix}, |
55 | # tail_dir => $default_tail_dir, |
56 | build_demos => ! $is_win32, |
57 | install_demos => ! $is_win32, |
58 | install_ssfe => ! $is_win32, |
59 | %{$conf} |
60 | ); |
61 | |
62 | ################ |
63 | # these are the top level action handlers. ACTION_foo gets called when you do |
64 | # 'Build foo' on the command line |
65 | ################ |
66 | |
67 | sub ACTION_build { |
68 | |
69 | my ( $self ) = @_ ; |
70 | |
71 | $self->query_for_config() ; |
72 | |
73 | $self->SUPER::ACTION_build() ; |
74 | |
75 | # $self->build_bin() ; |
76 | } |
77 | |
78 | sub ACTION_test { |
79 | |
80 | my ( $self ) = @_ ; |
81 | |
82 | local( @ENV{ keys %env } ) = values %env ; |
83 | |
84 | $self->depends_on('build'); |
85 | |
86 | $self->SUPER::ACTION_test() ; |
87 | } |
88 | |
89 | sub ACTION_install { |
90 | |
91 | my ( $self ) = @_ ; |
92 | |
93 | $self->install_config_files() ; |
94 | # $self->install_ssfe() ; |
95 | |
96 | $self->SUPER::ACTION_install() ; |
97 | } |
98 | |
99 | sub ACTION_run { |
100 | |
101 | my ( $self ) = @_ ; |
102 | |
103 | $self->depends_on('build'); |
104 | |
105 | my $run_cmd = $self->{'args'}{'cmd'} || '' ; |
106 | |
107 | $run_cmd or die "Missing cmd=name argument" ; |
108 | |
109 | my $cmd = "$env $run_cmd" ; |
110 | # print "CMD: $cmd\n" ; |
111 | |
112 | system $cmd ; |
113 | } |
114 | |
115 | sub ACTION_run_stem { |
116 | |
117 | my ( $self ) = @_ ; |
118 | |
119 | $self->depends_on('build'); |
120 | |
121 | my $conf = $self->{'args'}{'conf'} || '' ; |
122 | |
123 | $conf or die "Missing conf=name argument" ; |
124 | |
125 | my $cmd = "$env run_stem $conf" ; |
126 | # print "DEMO: $cmd\n" ; |
127 | |
128 | system $cmd ; |
129 | } |
130 | |
131 | |
132 | sub run_demo { |
133 | |
134 | my ( $self ) = @_ ; |
135 | |
136 | $self->depends_on('build'); |
137 | |
138 | my $cmd = "$env $self->{action}_demo" ; |
139 | print "DEMO: $cmd\n" ; |
140 | system $cmd ; |
141 | } |
142 | |
143 | |
144 | sub ACTION_tail { |
145 | |
146 | mkdir 'tail' ; |
147 | |
148 | unlink <tail/*> ; |
149 | |
150 | goto &run_demo ; |
151 | } |
152 | |
153 | *ACTION_chat = \&run_demo ; |
154 | *ACTION_chat2 = \&run_demo ; |
155 | *ACTION_inetd = \&run_demo ; |
156 | |
157 | sub ACTION_update_pod { |
158 | |
159 | my( $self ) = @_ ; |
160 | |
161 | my @manifest_sublist = $self->grep_manifest( qr/\.pm$/ ) ; |
162 | |
163 | @manifest_sublist = grep /Codec/, @manifest_sublist ; |
164 | |
165 | print join( "\n", @manifest_sublist ), "\n" ; |
166 | |
167 | system( "bin/spec2pod.pl @manifest_sublist" ) ; |
168 | |
169 | return; |
170 | } |
171 | |
172 | # grep through all matched files |
173 | # command line args: |
174 | # files=<regex> (default is all .pm files) |
175 | # re=<regex> |
176 | |
177 | sub ACTION_grep { |
178 | |
179 | my( $self ) = @_ ; |
180 | |
181 | my $args = $self->{'args'} ; |
182 | |
183 | my $file_regex = $args->{ files } || qr/\.pm$/ ; |
184 | my $grep_regex = $args->{ re } or die "need grep regex" ; |
185 | |
186 | my @manifest_sublist = $self->grep_manifest( $file_regex ) ; |
187 | |
188 | local( @ARGV ) = @manifest_sublist ; |
189 | |
190 | while( <> ) { |
191 | |
192 | next unless /$grep_regex/ ; |
193 | |
194 | print "$ARGV:$. $_" |
195 | } |
196 | continue { |
197 | |
198 | close ARGV if eof ; |
199 | } |
200 | |
201 | return; |
202 | } |
203 | |
204 | # ACTION: grep through MANIFEST |
205 | # command line args: |
206 | # files=<regex> |
207 | # |
208 | # do we need this action? |
209 | # |
210 | |
211 | sub ACTION_grep_manifest { |
212 | |
213 | my( $self ) = @_ ; |
214 | |
215 | my @manifest_sublist = $self->grep_manifest() ; |
216 | |
217 | print join( "\n", @manifest_sublist ), "\n" ; |
218 | return; |
219 | } |
220 | |
221 | # ACTION: count source lines |
222 | # command line args: |
223 | # files=<regex> (defaults to all .pm and bin files |
224 | # |
225 | # do we need this action? |
226 | |
227 | sub ACTION_lines { |
228 | |
229 | my( $self ) = @_ ; |
230 | |
231 | my $args = $self->{'args'} ; |
232 | my $file_regex = $args->{ files } || qr/\.pm$|^bin/ ; |
233 | |
234 | my @manifest_sublist = $self->grep_manifest( $file_regex ) ; |
235 | |
236 | system( "./util/lines @manifest_sublist" ) ; |
237 | |
238 | return; |
239 | } |
240 | |
241 | # build a distro and scp to stemsystems.com |
242 | |
243 | sub ACTION_ftp { |
244 | |
245 | my ( $self ) = @_ ; |
246 | |
247 | my $dist_tar = $self->dist_dir() . '.tar.gz' ; |
248 | |
249 | unlink $dist_tar ; |
250 | |
251 | $self->ACTION_dist() ; |
252 | |
253 | system "scp $dist_tar stemsystems.com:www/" ; |
254 | } |
255 | |
256 | |
257 | # this sub overrides the find_test_files method in Module::Build |
258 | |
259 | sub find_test_files { |
260 | |
261 | my ($self) = @_; |
262 | |
263 | my $test_args = $self->{ args }{ tests } ; |
264 | |
265 | my @tests = $test_args ? split( ':', $test_args ) : |
266 | $self->grep_manifest( qr/\.t$/ ) ; |
267 | |
268 | return \@tests ; |
269 | } |
270 | |
271 | sub process_script_files { |
272 | my( $self ) = @_ ; |
273 | |
274 | my @scripts = $self->grep_manifest( qr{^bin/} ) ; |
275 | |
276 | #print "SCR @scripts\n" ; |
277 | foreach my $file ( @scripts ) { |
278 | |
279 | my $bin_dir = File::Spec->catdir( |
280 | $self->blib, |
281 | $file =~ /_demo$/ ? 'demo' : 'bin' ) ; |
282 | |
283 | File::Path::mkpath( $bin_dir ); |
284 | |
285 | my $result = $self->copy_if_modified( |
286 | $file, $bin_dir, 'flatten') or next; |
287 | |
288 | #print "COPY $file\n" ; |
289 | $self->fix_run_stem($result); |
290 | $self->fix_demos($result); |
291 | $self->fix_shebang_line($result); |
292 | $self->make_executable($result); |
293 | } |
294 | } |
295 | |
296 | sub fix_run_stem { |
297 | |
298 | my( $self, $file ) = @_ ; |
299 | |
300 | return unless $file =~ m{/run_stem$} ; |
301 | |
302 | my $text = read_file( $file ) ; |
303 | |
304 | $text =~ s/'conf:.'/'$conf->{'conf_path'}'/ if $conf->{'conf_path'} ; |
305 | |
306 | write_file( $file, $text ) ; |
307 | } |
308 | |
309 | sub fix_demos { |
310 | |
311 | my( $self, $file ) = @_ ; |
312 | |
313 | return unless $file =~ /_demo$/ ; |
314 | |
315 | my $text = read_file( $file ) ; |
316 | |
317 | $conf->{xterm_path} ||= 'NOT FOUND' ; |
318 | $conf->{telnet_path} ||= 'NOT FOUND' ; |
319 | |
320 | $text =~ s[xterm][$conf->{xterm_path}]g; |
321 | $text =~ s[telnet][$conf->{telnet_path}]g; |
322 | |
323 | write_file( $file, $text ) ; |
324 | } |
325 | |
326 | # MANIFEST helper subs |
327 | |
328 | sub grep_manifest { |
329 | |
330 | my( $self, $file_regex ) = @_ ; |
331 | |
332 | $file_regex ||= $self->{ args }{ files } || qr/.*/ ; |
333 | |
334 | manifest_load() ; |
335 | |
336 | return grep( /$file_regex/, @manifest_lines ) ; |
337 | } |
338 | |
339 | sub manifest_load { |
340 | |
341 | return if @manifest_lines ; |
342 | |
343 | @manifest_lines = grep ! /^\s*$|^\s*#/, read_file( 'MANIFEST' ) ; |
344 | |
345 | chomp @manifest_lines ; |
346 | |
347 | return ; |
348 | } |
349 | |
350 | ################################# |
351 | |
352 | sub query_for_config { |
353 | |
354 | my( $self ) = @_ ; |
355 | |
356 | return if $defaults{ 'config_done' } ; |
357 | |
358 | print <<'EOT'; |
359 | |
360 | Building Stem |
361 | |
362 | This script will ask you various questions in order to properly |
363 | configure, build and install Stem on your system. Whenever a question |
364 | is asked, the default answer will be shown inside [brackets]. |
365 | Pressing enter will accept the default answer. If a choice needs to be |
366 | made from a list of values, that list will be inside (parentheses). |
367 | |
368 | If you have already configured Stem in a previous build, you can put |
369 | use_defaults=1 on the Build command line and you won't be prompted for |
370 | any answers and the previous settings will be used. |
371 | |
372 | If you want to force a new build, run Build clean. |
373 | |
374 | EOT |
375 | |
376 | $self->get_path_config() ; |
377 | $self->get_demo_config() ; |
378 | |
379 | $defaults{ 'config_done' } = 1 ; |
380 | |
381 | $self->write_config_pm() ; |
382 | } |
383 | |
384 | |
385 | my $package = 'Stem::InstallConfig' ; |
386 | |
387 | sub config_pm_path { |
388 | |
389 | return File::Spec->catfile( |
390 | File::Spec->curdir, 'lib', split( /::/, $package) ) . '.pm' ; |
391 | |
392 | } |
393 | |
394 | sub write_config_pm { |
395 | |
396 | my ( $self ) = @_ ; |
397 | |
398 | my $config = Data::Dumper->Dump( |
399 | [\%defaults], |
400 | ["*${package}::Config"] |
401 | ); |
402 | |
403 | my $conf_pm_file = $self->config_pm_path() ; |
404 | |
405 | $self->add_to_cleanup( $conf_pm_file ) ; |
406 | |
407 | write_file( $conf_pm_file, <<EOT ) ; |
408 | |
409 | # DO NOT EDIT |
410 | # this file is generated by running Build build |
411 | |
412 | package $package ; |
413 | |
414 | $config |
415 | 1 ; |
416 | EOT |
417 | |
418 | } |
419 | |
420 | |
421 | sub get_path_config { |
422 | |
423 | my( $self ) = @_ ; |
424 | |
425 | # $self->query_config_value( <<'EOT', 'perl_path' ); |
426 | |
427 | # Stem has several executable Perl programs and demonstration scripts |
428 | # and they need to have the correct path to your perl binary. |
429 | |
430 | # What is the path to perl? |
431 | # EOT |
432 | |
433 | # $self->query_config_value( <<'EOT', 'bin_path' ); |
434 | |
435 | # Those Stem executables need to be installed in a directory that is in your |
436 | # shell $PATH variable. |
437 | |
438 | # What directory will have the Stem executables? |
439 | # EOT |
440 | |
441 | $self->query_config_value( <<'EOT', 'conf_path' ); |
442 | |
443 | Stem configuration files are used to create and initialize Stem Cells |
444 | (objects). Stem needs to know the list of directories to search to |
445 | find its configurations files. |
446 | |
447 | Note that the default has a single absolute path. You can test Stem |
448 | configurations easily setting this path when executing run_stem. You |
449 | can override or modify the path time with either a shell environment |
450 | variable or on the command line of run_stem. See the documentation on |
451 | run_stem for how so do this. |
452 | |
453 | The first directory in the list is where the standard Stem |
454 | configuration files will be installed. |
455 | |
456 | Enter a list of absolute directory paths separated by ':'. |
457 | |
458 | What directories do you want to search for Stem configuration files? |
459 | EOT |
460 | |
461 | return ; |
462 | } |
463 | |
464 | sub get_demo_config { |
465 | |
466 | my( $self ) = @_ ; |
467 | |
468 | # don't even bother if win32 |
469 | |
470 | return if $is_win32 ; |
471 | |
472 | # $self->get_config_boolean( <<'EOT', 'build_demos' ); |
473 | |
474 | # Stem comes with several demonstration scripts. After building them, |
475 | # they can be run from the main directory by the Build script: ./Build |
476 | # chat, Build inetd, etc. Do you want to build the demos? |
477 | # EOT |
478 | |
479 | # return unless $defaults{build_demos}; |
480 | |
481 | # all the demos need xterm |
482 | |
483 | $self->get_xterm_path(); |
484 | $self->get_telnet_path(); |
485 | return unless -x $defaults{xterm_path} && -x $defaults{telnet_path}; |
486 | |
487 | # $self->query_config_value( <<'EOT', 'tail_dir' ); |
488 | |
489 | # The tail demo script needs a temporary working directory. Enter the |
490 | # path to a directory to use for this purpose. If it does not exist, |
491 | # this directory will be created. |
492 | # EOT |
493 | |
494 | $self->get_config_boolean( <<'EOT', 'install_ssfe' ); |
495 | |
496 | ssfe (Split Screen Front End) is a compiled program optionally used by |
497 | the Stem demonstration scripts that provides a full screen interface |
498 | with command line editing and history. It is not required to run Stem |
499 | but it makes the demonstrations easier to work with and they look much |
500 | nicer. To use ssfe add the '-s' option when you run any demonstration |
501 | script. You can also use ssfe for your own programs. Install ssfe in |
502 | some place in your \$PATH ($conf->{'bin_path'} is where Stem executables |
503 | are being installed) so it can be used by the demo scripts. The ssfe |
504 | install script will do this for you or you can do it manually after |
505 | building it. |
506 | |
507 | Do you want to install ssfe? |
508 | EOT |
509 | |
510 | } |
511 | |
512 | sub get_xterm_path { |
513 | |
514 | my( $self ) = @_ ; |
515 | |
516 | my $xterm_path; |
517 | |
518 | # unless ( $xterm_path = which_exec( 'xterm' ) ) { |
519 | |
520 | # foreach my $path ( qw( |
521 | # /usr/openwin/bin/xterm |
522 | # /usr/bin/X11/xterm |
523 | # /usr/X11R6/bin/xterm ) ) { |
524 | |
525 | # next unless -x $path; |
526 | # $xterm_path = $path ; |
527 | # last; |
528 | # } |
529 | # } |
530 | |
531 | # if ( $xterm_path ) { |
532 | |
533 | # $defaults{'xterm_path'} = $xterm_path ; |
534 | # print "xterm was found at '$xterm_path'\n"; |
535 | # return ; |
536 | # } |
537 | |
538 | $self->query_config_value( <<"EOT", 'xterm_path' ); |
539 | |
540 | xterm was not found on this system. you can't run the demo programs |
541 | without xterm. Make sure you enter a valid path to xterm or some other |
542 | terminal emulator. |
543 | |
544 | NOTE: If you don't have an xterm, you can still run the demo scripts |
545 | by hand. Run a *_demo script and see what commands it issues. Take the |
546 | part after the -e and run that command in its own terminal window. |
547 | |
548 | Enter the path to xterm (or another compatible terminal emulator) |
549 | EOT |
550 | |
551 | } |
552 | |
553 | sub get_telnet_path { |
554 | |
555 | my( $self ) = @_ ; |
556 | |
557 | my $telnet_path; |
558 | |
559 | unless ( $telnet_path = which_exec( 'telnet' ) ) { |
560 | |
561 | # enter a list of common places to find telnet. or delete this as it |
562 | # will almost always be in the path |
563 | |
564 | foreach my $path ( qw( ) ) { |
565 | |
566 | next unless -x $path; |
567 | $telnet_path = $path ; |
568 | last; |
569 | } |
570 | } |
571 | |
572 | if ( $telnet_path ) { |
573 | |
574 | $defaults{'telnet_path'} = $telnet_path ; |
575 | print "telnet was found at '$telnet_path'\n"; |
576 | return ; |
577 | } |
578 | |
579 | $self->query_config_value( <<"EOT", 'telnet_path' ); |
580 | |
581 | telnet was not found on this system. you can't run the demo programs |
582 | without telnet. Make sure you enter a valid path to telnet or some other |
583 | terminal emulator. |
584 | |
585 | NOTE: If you don't have an telnet, you can still run the demo scripts |
586 | by hand. Run a *_demo script and see what telnet commands it |
587 | issues. The run those telnet commands using your telnet or another |
588 | similar program. |
589 | |
590 | Enter the path to telnet (or another compatible terminal emulator) |
591 | EOT |
592 | |
593 | } |
594 | |
595 | sub install_config_files { |
596 | |
597 | my ( $self ) = @_ ; |
598 | |
599 | my ( $conf_path ) = split /:/, $conf->{conf_path} ; |
600 | |
601 | mkpath( $conf_path, 1, 0755 ) unless -d $conf_path ; |
602 | |
603 | my @config_files = $self->grep_manifest( qr{^conf/.+\.stem$} ) ; |
604 | |
605 | foreach my $conf_file (@config_files) { |
606 | |
607 | $conf_file =~ s{conf/}{} ; |
608 | |
609 | my $out_file = File::Spec->catfile( $conf_path, $conf_file ); |
610 | |
611 | print "Installing config file: $out_file\n"; |
612 | |
613 | my $in_file = File::Spec->catfile( |
614 | File::Spec->curdir(), 'conf', $conf_file ); |
615 | |
616 | my $conf_text = read_file($in_file); |
617 | |
618 | if ( $conf_file eq 'inetd.stem' ) { |
619 | |
620 | my $quote_serve = File::Spec->catfile( |
621 | $conf->{bin_path}, 'quote_serve' ); |
622 | |
623 | $conf_text =~ s[path\s+=>\s+'bin/quote_serve',] |
624 | [path\t\t=> '$quote_serve',]; |
625 | } |
626 | # elsif ( $conf eq 'monitor.stem' || $conf eq 'archive.stem' ) { |
627 | |
628 | # $conf_text =~ s[path'\s+=>\s+'tail] |
629 | # [path'\t\t=> '$conf->{tail_dir}]g ; |
630 | # } |
631 | |
632 | write_file( $out_file, $conf_text ); |
633 | } |
634 | } |
635 | |
636 | |
637 | sub install_ssfe { |
638 | |
639 | my ( $self ) = @_ ; |
640 | |
641 | return unless $conf->{install_stem_demos} && |
642 | $conf->{install_ssfe} ; |
643 | |
644 | print <<'EOT'; |
645 | |
646 | Installing ssfe. |
647 | |
648 | This is not a Stem install script and it will ask its own |
649 | questions. It will execute in its own xterm (whatever was configured |
650 | earlier) to keep this install's output clean. The xterm is kept open |
651 | with a long sleep call and can be exited by typing ^C. |
652 | |
653 | EOT |
654 | |
655 | ######### |
656 | # UGLY |
657 | ######### |
658 | |
659 | system <<'EOT'; |
660 | xterm -e /bin/sh -c 'chdir extras ; |
661 | tar zxvf sirc-2.211.tar.gz ; |
662 | chdir sirc-2.211 ; |
663 | ./install ; |
664 | sleep 1000 ;' |
665 | EOT |
666 | |
667 | print "\nInstallation of ssfe is done\n\n"; |
668 | } |
669 | |
670 | ######################################################### |
671 | # this sub builds the exec scripts in bin and puts them into blib/bin |
672 | # for local running or later installation |
673 | |
674 | # sub build_bin { |
675 | |
676 | # my ( $self ) = @_ ; |
677 | |
678 | # my @bin_scripts = $self->grep_manifest( qr{^bin/} ) ; |
679 | |
680 | # foreach my $bin_file ( @bin_scripts ) { |
681 | |
682 | # #print "BIN $bin_file\n" ; |
683 | |
684 | # my $bin_text = read_file( $bin_file ) ; |
685 | |
686 | # $bin_file =~ s{bin/}{} ; |
687 | |
688 | # # fix the shebang line |
689 | |
690 | # $bin_text =~ s{/usr/local/bin/perl}{$conf->{'perl_path'}} ; |
691 | |
692 | # my $bin_dir ; |
693 | |
694 | # if ( $bin_file =~ /_demo$/ ) { |
695 | |
696 | # next unless $conf->{build_demos} ; |
697 | |
698 | # $bin_dir = 'demo' ; |
699 | |
700 | # # fix the location of xterms in the demo scripts |
701 | |
702 | # $bin_text =~ s[xterm][$conf->{xterm_path}]g; |
703 | # $bin_text =~ s[telnet][$conf->{telnet_path}]g; |
704 | |
705 | # # fix the default config search path in run_stem |
706 | # } |
707 | # else { |
708 | |
709 | # $bin_dir = 'bin' ; |
710 | |
711 | # # fix the default config search path in run_stem |
712 | |
713 | # if ( $bin_file eq 'run_stem' ) { |
714 | # $bin_text =~ |
715 | # s/'conf:.'/'$conf->{'conf_path'}'/ ; |
716 | # } |
717 | # } |
718 | |
719 | # # elsif ( $bin_file eq 'tail_demo' ) { |
720 | # # $bin_text =~ s['tail']['$conf->{tail_dir}']; |
721 | # # } |
722 | |
723 | # # write the built script into the blib/ dir |
724 | |
725 | # my $out_file = File::Spec->catfile( 'blib', |
726 | # $bin_dir, |
727 | # $bin_file |
728 | # ); |
729 | |
730 | # mkdir "blib/$bin_dir" ; |
731 | # print "Building executable script: $out_file\n"; |
732 | # write_file( $out_file, $bin_text ); |
733 | # chmod 0755, $out_file; |
734 | # } |
735 | # } |
736 | |
737 | ############################################################# |
738 | |
739 | # this sub searches the path for the locations of an executable |
740 | |
741 | sub which_exec { |
742 | |
743 | my ( $exec ) = @_; |
744 | |
745 | foreach my $path_dir ( split /[:;]/, $ENV{PATH} ) { |
746 | |
747 | my $exec_path = File::Spec->catfile( $path_dir, $exec ); |
748 | return $exec_path if -x $exec_path ; |
749 | } |
750 | |
751 | return; |
752 | } |
753 | |
754 | # the sub searches a list of dir paths to find the first one that |
755 | # exists with a prefix dir |
756 | |
757 | # UNUSED FOR THE MOMENT |
758 | |
759 | # sub which_dir { |
760 | |
761 | # my ( $prefix, @dirs ) = @_; |
762 | |
763 | # foreach my $subdir ( @dirs ) { |
764 | |
765 | # my $dir = File::Spec->catfile( $prefix, $subdir ); |
766 | # return $dir if -x $dir; |
767 | # } |
768 | |
769 | # return; |
770 | # } |
771 | |
772 | ############################################################# |
773 | |
774 | # these subs handle querying for a user answer. it uses the key to |
775 | # find a current value in the defaults and prompt for another value |
776 | # if 'use_defaults' is set on the command line, then no prompting will be done |
777 | |
778 | sub query_config_value { |
779 | |
780 | my( $self, $query, $key ) = @_ ; |
781 | |
782 | my $default = $self->{args}{$key} ; |
783 | |
784 | $default = $defaults{ $key } unless defined $default ; |
785 | |
786 | $defaults{ $key } = ( $self->{args}{use_defaults} ) ? |
787 | $default : |
788 | $self->prompt( edit_query( $query, $default ), $default ) ; |
789 | } |
790 | |
791 | sub get_config_boolean { |
792 | |
793 | my( $self, $query, $key ) = @_ ; |
794 | |
795 | my $default = $self->{args}{$key} ; |
796 | |
797 | $default = $defaults{ $key } unless defined $default ; |
798 | $default =~ tr/01/ny/ ; |
799 | |
800 | $defaults{ $key } = ( $self->{args}{use_defaults} ) ? |
801 | $default : |
802 | $self->y_n( edit_query( $query, $default ), $default ) ; |
803 | } |
804 | |
805 | sub edit_query { |
806 | |
807 | my ( $query, $default ) = @_ ; |
808 | |
809 | chomp $query ; |
810 | |
811 | $default ||= '' ; |
812 | |
813 | my $last_line = (split /\n/, $query)[-1] ; |
814 | |
815 | if ( length( $last_line ) + 2 * length( $default ) > 70 ) { |
816 | |
817 | $query .= "\n\t" ; |
818 | } |
819 | |
820 | return $query ; |
821 | } |
822 | |
823 | # low level file i/o subs. should be replaced with File::Slurp. stem |
824 | # should depend on it |
825 | |
826 | |
827 | sub read_file { |
828 | |
829 | my ( $file_name ) = @_ ; |
830 | |
831 | local( *FH ); |
832 | |
833 | open( FH, $file_name ) || croak "Can't open $file_name $!"; |
834 | |
835 | return <FH> if wantarray; |
836 | |
837 | read FH, my $buf, -s FH; |
838 | return $buf; |
839 | } |
840 | |
841 | sub write_file { |
842 | |
843 | my( $file_name ) = shift ; |
844 | |
845 | local( *FH ) ; |
846 | |
847 | open( FH, ">$file_name" ) || croak "can't create $file_name $!" ; |
848 | |
849 | print FH @_ ; |
850 | } |
851 | |
852 | 1 ; |