view release on metacpan or  search on metacpan

install_util/gbrowse_ppm_install.PLS  view on Meta::CPAN

print STDERR "** Now go to http://your.server/gbrowse for further setup instructions.\n";

exit 0;

sub prompt_for_directory {
  my ($prompt,$default) = @_;
  my $dir;
  while (!$dir) {
    $dir = prompt("\t\"$prompt\" directory ([q]uit)",$default);
    if ($dir eq 'q') {
      print STDERR "ABORTED: your installation is NOT complete\n\n";
      exit 0;
    } 
    $dir = interpolate($dir);
    if (!-d $dir) {
      print STDERR "$dir doesn't exist.  Please try again.\n";
      redo;
    } elsif (!-w $dir) {
      print STDERR "warning: $dir isn't writable. Installation may fail.\n";
    }
  }
  return $dir;
}

sub interpolate {
  my $path = shift;
  my ($to_expand,$homedir);
  return $path unless $path =~ m!^~([^/]*)!;
  eval {
    if ($to_expand = $1) {
      $homedir = (getpwnam($to_expand))[7];
    } else {
      $homedir = (getpwuid($<))[7];
    }
    return $path unless $homedir;
    $path =~ s!^~[^/]*!$homedir!;
  };
  return $path;
}

# horrible -- fix line endings for proper architecture
sub fixup {
  my $file = shift;
  my $conf = shift;
  return unless -f $file;
  local $/ = "\012";
  open F,$file or die "Can't open $file: $!";
  open OUT,">$file.new" or die "Can't open $file.new: $!";
  while (<F>) {
    chomp;
    s/^\#!.+/$startperl -w/;
    s/^\$CONF_DIR\s*=\s*\'.+/\$CONF_DIR = '$conf';/;
    print OUT $_,"\n";
  }
  close F;
  close OUT;
  rename "$file.new",$file;
}
!NO!SUBS!
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';