home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Scripts.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-28  |  1.4 KB  |  46 lines
  1. # $File: //depot/cpan/Module-Install/lib/Module/Install/Scripts.pm $ $Author: autrijus $
  2. # $Revision: #7 $ $Change: 1841 $ $DateTime: 2003/12/28 19:43:56 $ vim: expandtab shiftwidth=4
  3.  
  4. package Module::Install::Scripts;
  5. use Module::Install::Base; @ISA = qw(Module::Install::Base);
  6. $VERSION = '0.01';
  7. use strict;
  8. use File::Basename ();
  9.  
  10. sub prompt_script {
  11.     my ($self, $script_file) = @_;
  12.     my ($prompt, $abstract, $default);
  13.  
  14.     foreach my $line ( $self->_read_script($script_file) ) {
  15.         last unless $line =~ /^#/;
  16.         $prompt = $1   if $line =~ /^#\s*prompt:\s+(.*)/;
  17.         $default = $1  if $line =~ /^#\s*default:\s+(.*)/;
  18.         $abstract = $1 if $line =~ /^#\s*abstract:\s+(.*)/;
  19.     }
  20.     unless (defined $prompt) {
  21.         my $script_name = File::Basename::basename($script_file);
  22.         $prompt = "Do you want to install '$script_name'";
  23.         $prompt .= " ($abstract)" if defined $abstract;
  24.         $prompt .= '?';
  25.     }
  26.     return unless $self->prompt($prompt, ($default || 'n')) =~ /^[Yy]/;
  27.     $self->install_script($script_file);
  28. }
  29.  
  30. sub install_script {
  31.     my ($self, $script_file) = @_;
  32.     my $args = $self->makemaker_args;
  33.     my $exe_files = $args->{EXE_FILES} ||= [];
  34.     push @$exe_files, $script_file;
  35. }
  36.  
  37. sub _read_script {
  38.     my ($self, $script_file) = @_;
  39.     local *SCRIPT;
  40.     open SCRIPT, $script_file
  41.       or die "Can't open '$script_file' for input: $!\n";
  42.     return <SCRIPT>;
  43. }
  44.  
  45. 1;
  46.