# Probably installhtml needs to join the club.
use strict;
-use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare
+use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare $Is_AmigaOS
%opts $packlist);
use subs qw(unlink link chmod);
+require File::Path;
+require File::Copy;
-use Config;
BEGIN {
- if ($Config{userelocatableinc}) {
+ require Config;
+ if ($Config::Config{userelocatableinc}) {
# This might be a considered a hack. Need to get information about the
# configuration from Config.pm *before* Config.pm expands any .../
# prefixes.
# So we set $^X to pretend that we're the already installed perl, so
# Config.pm does its ... expansion off that location.
- my $location = $Config{initialinstalllocation};
+ my $location = $Config::Config{initialinstalllocation};
die <<'OS' unless defined $location;
$Config{initialinstalllocation} is not defined - can't install a relocatable
perl without this.
# You never saw us. We weren't here.
require Config;
- Config->import;
}
+ Config->import;
}
if ($Config{d_umask}) {
$Is_Cygwin = $^O eq 'cygwin';
$Is_Darwin = $^O eq 'darwin';
$Is_NetWare = $Config{osname} eq 'NetWare';
+$Is_AmigaOS = $^O eq 'amigaos';
sub unlink {
my(@names) = @_;
foreach my $name (@names) {
next unless -e $name;
- chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare);
+ chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare || $Is_AmigaOS);
print " unlink $name\n" if $opts{verbose};
( CORE::unlink($name) and ++$cnt
or warn "Couldn't unlink $name: $!\n" ) unless $opts{notify};
$xto =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
print $opts{verbose} ? " ln $xfrom $xto\n" : " $xto\n"
unless $opts{silent};
+ my $link = $Is_AmigaOS ? \&CORE::symlink : \&CORE::link;
eval {
- CORE::link($from, $to)
- ? $success++
- : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
- ? die "AFS" # okay inside eval {}
- : die "Couldn't link $from to $to: $!\n"
- unless $opts{notify};
- $packlist->{$xto} = { from => $xfrom, type => 'link' };
- };
+ $link->($from, $to)
+ ? $success++
+ : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
+ ? die "AFS" # okay inside eval {}
+ : die "Couldn't link $from to $to: $!\n"
+ unless $opts{notify};
+ $packlist->{$xto} = { from => $xfrom, type => 'link' };
+ };
if ($@) {
warn "Replacing link() with File::Copy::copy(): $@";
print $opts{verbose} ? " cp $from $xto\n" : " $xto\n"
unless $opts{notify};
}
-
sub samepath {
my($p1, $p2) = @_;
return (lc($p1) eq lc($p2)) if ($Is_W32 || $Is_NetWare);
- if ($p1 ne $p2) {
- my($dev1, $ino1, $dev2, $ino2);
- ($dev1, $ino1) = stat($p1);
- ($dev2, $ino2) = stat($p2);
- ($dev1 == $dev2 && $ino1 == $ino2);
- }
- else {
- 1;
- }
+ return 1
+ if $p1 eq $p2;
+
+ my ($dev1, $ino1) = stat $p1;
+ return 0
+ unless defined $dev1;
+ my ($dev2, $ino2) = stat $p2;
+
+ return $dev1 == $dev2 && $ino1 == $ino2;
}
sub safe_rename {
unlink($from);
}
+sub mkpath {
+ File::Path::mkpath(shift , $opts{verbose}, 0777) unless $opts{notify};
+}
+
+sub unixtoamiga
+{
+ my $unixpath = shift;
+
+ my @parts = split("/",$unixpath);
+ my $isdir = 0;
+ $isdir = 1 if substr($unixpath,-1) eq "/";
+
+ my $first = 1;
+ my $amigapath = "";
+
+ my $i = 0;
+
+ for($i = 0; $i <= $#parts;$i++)
+ {
+ next if $parts[$i] eq ".";
+ if($parts[$i] eq "..")
+ {
+ $parts[$i] = "/";
+ }
+ if($i == 0)
+ {
+ if($parts[$i] eq "")
+ {
+ $amigapath .= $parts[$i + 1] . ":";
+ $i++;
+ next;
+ }
+ }
+ $amigapath .= $parts[$i];
+ if($i != $#parts)
+ {
+ $amigapath .= "/" unless $parts[$i] eq "/" ;
+ }
+ else
+ {
+ if($isdir)
+ {
+ $amigapath .= "/" unless $parts[$i] eq "/" ;
+ }
+ }
+ }
+
+ return $amigapath;
+}
+
+sub amigaprotect
+{
+ my ($file,$bits) = @_;
+ print "PROTECT: File $file\n";
+ system("PROTECT $file $bits")
+ unless $opts{notify};
+}
+
1;