aboutsummaryrefslogtreecommitdiffstats
path: root/lang/perl5.14/files
diff options
context:
space:
mode:
authortobez <tobez@FreeBSD.org>2005-06-24 17:17:06 +0800
committertobez <tobez@FreeBSD.org>2005-06-24 17:17:06 +0800
commit85945fb6cfcff1aeb2931fecd4725ade082d171a (patch)
tree6733402c0f17cf5bdefd3b87e5dc5c3021426287 /lang/perl5.14/files
parent5b91ce0a50857b4fdd670e0926e669faf8bec6dd (diff)
downloadfreebsd-ports-graphics-85945fb6cfcff1aeb2931fecd4725ade082d171a.tar.gz
freebsd-ports-graphics-85945fb6cfcff1aeb2931fecd4725ade082d171a.tar.zst
freebsd-ports-graphics-85945fb6cfcff1aeb2931fecd4725ade082d171a.zip
Upgrade to 5.8.7. In addition:
- add perl-after-upgrade utility to move around dependent packages - fix $0 expansion in use.perl [1] - enable threaded perl on amd64 [2] - always compile perl with -pthread [3] - fix errno issue in SDBM_File [4] - add support for // and err (defined-or) [5] - add WITH_DEBUGGING option [6] - fix suidperl symlink [7] - fix several small bugs in use.perl - print possible WITH_XXX flags (no OPTIONS support yet) [1] Submitted by: erwin, Niƫl Dogger <niel@introweb.nl> [2] Nudged by: Mike Schroll <FreeBSD@LogicX.us> [3] Nudged by: skv [4] perl bug #35938 [5] Obtained from: H.Merijn Brand <h.m.brand@xs4all.nl> [6] PR: 78811, submitted by: skv [7] PR: 80069, submitted by: Sergey N. Voronkov <serg@tmn.ru> A different solution was actually implemented.
Diffstat (limited to 'lang/perl5.14/files')
-rw-r--r--lang/perl5.14/files/patch-Path.pm30
-rw-r--r--lang/perl5.14/files/patch-SDBM-errno-fix16
-rw-r--r--lang/perl5.14/files/patch-patchlevel.h13
-rw-r--r--lang/perl5.14/files/patch-perlio.c22
-rw-r--r--lang/perl5.14/files/perl-after-upgrade629
-rw-r--r--lang/perl5.14/files/use.perl22
6 files changed, 658 insertions, 74 deletions
diff --git a/lang/perl5.14/files/patch-Path.pm b/lang/perl5.14/files/patch-Path.pm
deleted file mode 100644
index 2735b0f6a64..00000000000
--- a/lang/perl5.14/files/patch-Path.pm
+++ /dev/null
@@ -1,30 +0,0 @@
-$FreeBSD$
---- lib/File/Path.pm.orig Sat Jan 29 20:23:40 2005
-+++ lib/File/Path.pm Sat Jan 29 20:24:56 2005
-@@ -196,7 +196,7 @@ sub rmtree {
- # it's also intended to change it to writable in case we have
- # to recurse in which case we are better than rm -rf for
- # subtrees with strange permissions
-- chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
-+ chmod(0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
- or carp "Can't make directory $root read+writeable: $!"
- unless $safe;
-
-@@ -230,7 +230,7 @@ sub rmtree {
- print "skipped $root\n" if $verbose;
- next;
- }
-- chmod 0777, $root
-+ chmod 0700, $root
- or carp "Can't make directory $root writeable: $!"
- if $force_writeable;
- print "rmdir $root\n" if $verbose;
-@@ -252,7 +252,7 @@ sub rmtree {
- print "skipped $root\n" if $verbose;
- next;
- }
-- chmod 0666, $root
-+ chmod 0600, $root
- or carp "Can't make file $root writeable: $!"
- if $force_writeable;
- print "unlink $root\n" if $verbose;
diff --git a/lang/perl5.14/files/patch-SDBM-errno-fix b/lang/perl5.14/files/patch-SDBM-errno-fix
new file mode 100644
index 00000000000..2dcf809d92d
--- /dev/null
+++ b/lang/perl5.14/files/patch-SDBM-errno-fix
@@ -0,0 +1,16 @@
+--- ext/SDBM_File/sdbm/sdbm.c.orig Thu Jun 23 08:06:21 2005
++++ ext/SDBM_File/sdbm/sdbm.c Thu Jun 23 08:06:57 2005
+@@ -34,11 +34,8 @@
+ /*
+ * externals
+ */
+-#ifndef WIN32
+-#ifndef sun
+-extern int errno;
+-#endif
+-#endif
++
++#include <errno.h>
+
+ extern Malloc_t malloc proto((MEM_SIZE));
+ extern Free_t free proto((Malloc_t));
diff --git a/lang/perl5.14/files/patch-patchlevel.h b/lang/perl5.14/files/patch-patchlevel.h
deleted file mode 100644
index c24961cf5db..00000000000
--- a/lang/perl5.14/files/patch-patchlevel.h
+++ /dev/null
@@ -1,13 +0,0 @@
-$FreeBSD$
-
---- patchlevel.h.orig Wed Feb 2 16:45:30 2005
-+++ patchlevel.h Wed Feb 2 16:45:34 2005
-@@ -120,6 +120,8 @@ hunk.
- #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
- static char *local_patches[] = {
- NULL
-+ ,"SUIDPERLIO0 - fix PERLIO_DEBUG local root exploit (CAN-2005-0155)"
-+ ,"SUIDPERLIO1 - fix PERLIO_DEBUG buffer overflow (CAN-2005-0156)"
- ,NULL
- };
-
diff --git a/lang/perl5.14/files/patch-perlio.c b/lang/perl5.14/files/patch-perlio.c
deleted file mode 100644
index c680381d212..00000000000
--- a/lang/perl5.14/files/patch-perlio.c
+++ /dev/null
@@ -1,22 +0,0 @@
-$FreeBSD$
-
---- perlio.c.orig Wed Feb 2 16:45:24 2005
-+++ perlio.c Wed Feb 2 16:45:34 2005
-@@ -454,7 +454,7 @@ PerlIO_debug(const char *fmt, ...)
- va_list ap;
- dSYS;
- va_start(ap, fmt);
-- if (!dbg) {
-+ if (!dbg && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
- char *s = PerlEnv_getenv("PERLIO_DEBUG");
- if (s && *s)
- dbg = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
-@@ -471,7 +471,7 @@ PerlIO_debug(const char *fmt, ...)
- s = CopFILE(PL_curcop);
- if (!s)
- s = "(none)";
-- sprintf(buffer, "%s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
-+ sprintf(buffer, "%.40s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
- len = strlen(buffer);
- vsprintf(buffer+len, fmt, ap);
- PerlLIO_write(dbg, buffer, strlen(buffer));
diff --git a/lang/perl5.14/files/perl-after-upgrade b/lang/perl5.14/files/perl-after-upgrade
new file mode 100644
index 00000000000..a60cd8e93ec
--- /dev/null
+++ b/lang/perl5.14/files/perl-after-upgrade
@@ -0,0 +1,629 @@
+#! %%PERL%% -w
+# ----------------------------------------------------------------------------
+# "THE BEER-WARE LICENSE" (Revision 42)
+# <tobez@FreeBSD.org> wrote this file. As long as you retain this notice you
+# can do whatever you want with this stuff. If we meet some day, and you think
+# this stuff is worth it, you can buy me a beer in return. Anton Berezin
+# ----------------------------------------------------------------------------
+#
+# $FreeBSD$
+# $Id: perl-after-upgrade,v 1.11 2005/06/23 19:39:00 tobez Exp $
+#
+=pod
+
+=head1 NAME
+
+perl-after-upgrade -- fixup FreeBSD packages that depend on perl
+
+=head1 SYNOPSIS
+
+ perl-after-upgrade
+ perl-after-upgrade -f
+ perl-after-upgrade -v
+
+=head1 DESCRIPTION
+
+The standard procedure after a perl port (either lang/perl5 or
+lang/perl5.8) upgrade is to basically reinstall all other packages that
+depend on perl. This is always a painful exercise. The
+perl-after-upgrade utility makes this process mostly unnecessary.
+
+The tool goes through the list of installed packages, looks for those
+that depend on perl, moves files around, modifies shebang lines in those
+scripts in which it is necessary to do so, tries its best to adjust
+dynamically linked binaries that link with libperl.so in the old path,
+and updates the package database.
+
+After installation of the new perl is complete, either by hand from the
+ports collection, or from a package, or via portupgrade, do the
+following:
+
+=over 4
+
+=item o go root;
+
+=item o run perl-after-upgrade utility.
+
+Do not specify any arguments at first, so it does nothing destructive.
+Pay attention to the produced output and especially to errorlist at the
+end, if any;
+
+=item o run the utility again, with B<-f> command line option.
+
+This will actually do the work. Again, pay attention to the output
+produced;
+
+=item o fix any reported errors;
+
+=item o reinstall required packages:
+
+The utility will tell you what packages that depend on perl it could not
+handle. It will also tell you why it happened (for example, they were
+compiled against a binary incompatible perl). If you want such packages
+to remain operational, you will have to reinstall then by hand or via
+portupgrade.
+
+=item o review the files left in the older perl installation.
+
+This is typically /usr/local/lib/perl5/site_perl/5.X.Y/. There should
+be very little, if any, files in that directory and its subdirectories,
+excepting a number of .ph files;
+
+=item o check that things work as they should;
+
+=item o remove backup files from the package database.
+
+Those will be /var/db/pkg/*/+CONTENTS.bak;
+
+=item o that's all.
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2005 by Anton Berezin
+
+ "THE BEER-WARE LICENSE" (Revision 42)
+ <tobez@FreeBSD.org> wrote this module. As long as you retain this
+ notice you can do whatever you want with this stuff. If we meet some
+ day, and you think this stuff is worth it, you can buy me a beer in
+ return.
+
+ Anton Berezin
+
+NO WARRANTY OF ANY KIND, USE AT YOUR OWN RISK.
+
+=head1 HISTORY
+
+The first version of this utility was not bundled with perl package on
+FreeBSD. It was dumber than the current version in several important
+areas. It was faster.
+
+=head1 CREDITS
+
+Thanks to Mathieu Arnold for discussion.
+
+=head1 SEE ALSO
+
+perl(1).
+
+=cut
+
+my $debug = 0;
+
+# |/-\
+my $pchar = "|";
+my $do_progress = -t *STDOUT;
+sub progress
+{
+ if ($do_progress) {
+ print STDERR "$pchar";
+ $pchar =~ tr<|/\\-><-|/\\>;
+ }
+}
+
+package FreeBSD::Package;
+use IO::File;
+use File::Copy;
+
+sub new
+{
+ my ($pkg, %p) = @_;
+ my $pkgdir = $p{pkgdir} || return undef;
+ my $name = $pkgdir;
+ $name =~ s|.*/||;
+ main::progress();
+ my $c = IO::File->new("< $pkgdir/+CONTENTS");
+ return undef unless $c;
+ my @lines;
+ while (<$c>) {
+ chomp;
+ push @lines, $_;
+ }
+ my $me = bless {
+ pkgdir => $pkgdir,
+ lines => \@lines,
+ name => $name,
+ }, $pkg;
+ return $me;
+}
+
+sub name
+{
+ return $_[0]->{name};
+}
+
+sub lines
+{
+ my $me = shift;
+ if (@_ && @_ == 1 && ref(@_) eq 'ARRAY') {
+ $me->{lines} = [@{$_[0]}];
+ $me->{changed} = 1;
+ } elsif (@_) {
+ $me->{lines} = [@_];
+ $me->{changed} = 1;
+ } else {
+ return @{$me->{lines}};
+ }
+}
+
+sub write_back
+{
+ my ($me) = @_;
+
+ return unless $me->{changed};
+ main::progress();
+ my $file = "$me->{pkgdir}/+CONTENTS";
+ copy($file, "$file.bak");
+ my $c = IO::File->new("> $file");
+ return unless $c;
+ for (@{$me->{lines}}) {
+ print $c "$_\n";
+ }
+}
+
+package FreeBSD::Package::DB;
+use strict;
+
+sub new
+{
+ my ($pkg, %p) = @_;
+ my $me = bless {
+ dbdir => $p{dbdir} || $ENV{PKG_DBDIR} || "/var/db/pkg",
+ }, $pkg;
+ $me->{packages} = [ grep { -d } glob "$me->{dbdir}/*" ];
+ $me->reset;
+ return $me;
+}
+
+sub next
+{
+ my ($me) = @_;
+ while (1) {
+ $me->{current}++;
+ if ($me->{current} >= @{$me->{packages}}) {
+ $me->reset;
+ return undef;
+ }
+ my $pkg = FreeBSD::Package->new(pkgdir => $me->{packages}->[$me->{current}]);
+ return $pkg if $pkg;
+ }
+}
+
+sub reset
+{
+ my ($me) = @_;
+ $me->{current} = -1;
+}
+
+package main;
+use Config;
+use File::Temp qw/tempfile/;
+use File::Copy;
+
+my $dry_run = 1;
+my @tmpl;
+my $VERSION = "1.2";
+
+while (@ARGV) {
+ my $opt = shift;
+ if ($opt eq "-f") {
+ $dry_run = 0;
+ } elsif ($opt eq "-d") {
+ $debug = 1;
+ } elsif ($opt eq "-v") {
+ $_ = $0;
+ s|.*/||;
+ print "$_ version $VERSION\n";
+ exit 0;
+ } elsif ($opt =~ /^-/) {
+ $_ = $0;
+ s|.*/||;
+ print "Unknown option `$opt'\n";
+ print "Usage:\n";
+ print "\t$_\n\t$_ -v\n\t$_ -f\n";
+ exit 1;
+ } else {
+ push @tmpl, $opt;
+ }
+}
+
+my $target =
+ $Config::Config{PERL_REVISION} . "." .
+ $Config::Config{PERL_VERSION} . "." .
+ $Config::Config{PERL_SUBVERSION};
+my $source = "";
+my $api_revision = $Config::Config{api_revision} || 0;
+my $api_version = $Config::Config{api_version} || 0;
+my $api_subversion = $Config::Config{api_subversion} || 0;
+if ($api_revision < $Config::Config{PERL_REVISION}) {
+ $source = ".[";
+ for ($api_revision .. $Config::Config{PERL_REVISION}) {
+ $source .= $_;
+ }
+ $source .= "]\\.\\d+\\.\\d+";
+} elsif ($api_revision > $Config::Config{PERL_REVISION}) {
+ die "internal error, this perl is too old\n";
+} else {
+ $source .= "$Config::Config{PERL_REVISION}\\.";
+ if ($api_version < $Config::Config{PERL_VERSION}) {
+ $source .= "[";
+ for ($api_version .. $Config::Config{PERL_VERSION}) {
+ $source .= $_;
+ }
+ $source .= "]\\.\\d+";
+ } elsif ($api_version > $Config::Config{PERL_VERSION}) {
+ die "internal error, this perl is too old\n";
+ } else {
+ $source .= "$Config::Config{PERL_VERSION}\\.";
+ if ($api_subversion < $Config::Config{PERL_SUBVERSION}) {
+ $source .= "[";
+ for ($api_subversion .. $Config::Config{PERL_SUBVERSION}) {
+ $source .= $_;
+ }
+ $source .= "]";
+ } elsif ($api_subversion > $Config::Config{PERL_SUBVERSION}) {
+ die "internal error, this perl is too old\n";
+ } else {
+ $source .= "$Config::Config{PERL_SUBVERSION}\\.";
+ }
+ }
+}
+print STDERR "- Source re: <$source>\n" if $debug;
+
+my $fuzzy_source = "5\\.[\\d._]+";
+print STDERR "- Fuzzy source re: <$fuzzy_source>\n" if $debug;
+
+my @errors;
+my @notes;
+
+sub fix_script
+{
+ my ($file, $target) = @_;
+
+ main::progress();
+ return 1 if $dry_run;
+ my $sf = IO::File->new("< $file");
+ return "" unless $sf;
+ my $line = <$sf>;
+ my $md5 = "";
+ if ($line && $line =~ s|^(\s*#!\s*[\w/]+perl)$fuzzy_source\b|$1$target|) {
+ my $dir = $file;
+ $dir =~ s|/[^/]+$||;
+ my ($fh, $fn) = tempfile(DIR=> $dir);
+ if ($fh) {
+ print $fh $line;
+ while (<$sf>) {
+ print $fh $_;
+ }
+ close $fh;
+ $md5 = `/sbin/md5 -q $fn`;
+ chomp $md5;
+ my $mode = (stat($file))[2] & 07777;
+ unlink $file or do {
+ push @errors, "Failed to unlink $file: $!";
+ unlink $fn;
+ return "";
+ };
+ rename $fn, $file or do {
+ push @errors, "Failed to rename $fn to $file: $!";
+ return "";
+ };
+ chmod $mode, $file;
+ } else {
+ push @errors, "Failed to modify $file: $!";
+ }
+ }
+ return $md5;
+}
+
+sub fix_binary
+{
+ my ($file, $target) = @_;
+
+ main::progress();
+ my $sf = IO::File->new("< $file");
+ return "" unless $sf;
+ my $was = $dry_run ? "would be" : "was";
+ push @notes, "The $file binary $was modified, make sure it works";
+ return 1 if $dry_run;
+ my $md5 = "";
+
+ my $dir = $file;
+ $dir =~ s|/[^/]+$||;
+ my ($fh, $fn) = tempfile(DIR=> $dir);
+ unless ($fn) {
+ push @errors, "Failed to modify $file: $!";
+ return "";
+ }
+
+ while (<$sf>) {
+ s|/lib/perl5/$fuzzy_source/mach/CORE|/lib/perl5/$target/mach/CORE|g;
+ print $fh $_;
+ }
+ close $fh;
+ $md5 = `/sbin/md5 -q $fn`;
+ chomp $md5;
+ my $mode = (stat($file))[2] & 07777;
+ unlink $file or do {
+ push @errors, "Failed to unlink $file: $!";
+ unlink $fn;
+ return "";
+ };
+ rename $fn, $file or do {
+ push @errors, "Failed to rename $fn to $file: $!";
+ return "";
+ };
+ chmod $mode, $file;
+ return $md5;
+}
+
+sub mkdir_recur
+{
+ my ($dir) = @_;
+
+ main::progress();
+ $dir =~ s|/+$||;
+ my $orig = $dir;
+ if ($dir =~ m|^$|) {
+ return 1;
+ } else {
+ $dir =~ s|/[^/]+$||;
+ my $r = mkdir_recur($dir);
+ return $r unless $r;
+ mkdir $orig, 0777;
+ my $e = $!;
+ unless (-d $orig) {
+ push @errors, "Could not create directory $orig: $e";
+ return 0;
+ }
+ return 1;
+ }
+}
+
+sub might_need_to_fix
+{
+ my ($pkg) = @_;
+ my $pkg_name = $pkg->name;
+
+ main::progress();
+ if ($pkg_name =~ /^bsdpan-/) {
+ return 1;
+ }
+ for ($pkg->lines) {
+ if (/^\@pkgdep\s+perl-($fuzzy_source)\S*\s*$/) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub fixable_binary
+{
+ my ($file, $name) = @_;
+
+ main::progress();
+ my $fixable = 0;
+ for (`/usr/bin/ldd $file 2>&1`) {
+ if (/^\s+libperl\.so\s+=>/) {
+ my $found;
+ for (`strings $file`) {
+ if (m</lib/perl5/($fuzzy_source)/mach/CORE>) {
+ $found++;
+ if (length($1) != length($target)) {
+ push @notes, "$name cannot be fixed up (and has to be reinstalled): cannot patch $file due to length difference";
+ print STDERR "- Skipping $name: cannot patch $file due to length difference\n" if $debug;
+ return undef;
+ }
+ print STDERR "- $name: fixable binary $file\n" if $debug && $found < 2;
+ $fixable = 1 if $1 ne $target;
+ }
+ }
+ if (!$found) {
+ push @notes, "$name cannot be fixed up (and has to be reinstalled): $file is using unknown libperl";
+ print STDERR "- Skipping $name: $file is using unknown libperl\n" if $debug;
+ return undef;
+ }
+ }
+ }
+ return $fixable;
+}
+
+sub fixable_shared_lib
+{
+ my ($file, $name) = @_;
+
+ main::progress();
+ my ($old);
+ for (`strings $file`) {
+ if (/^perl_get_sv$/) {
+ push @notes, "$name cannot be fixed up (and has to be reinstalled): $file uses an old perl API";
+ print STDERR "- Skipping $name: $file uses an old perl API\n" if $debug;
+ return 0;
+ }
+ }
+ return 1;
+}
+
+sub cannot_be_fixed
+{
+ my ($pkg, $binaries, $scripts) = @_;
+ my $pkg_name = $pkg->name;
+ my $prefix = "";
+
+ main::progress();
+
+ for ($pkg->lines) {
+ if (/^\@cwd\s+(\S+)\s*$/) {
+ $prefix = $1;
+ next;
+ }
+ my $file = "$prefix/$_";
+ next if -l $file;
+ next if $file =~ /\.gz$/;
+ next if $file =~ /\.bz2$/;
+ my $sf = IO::File->new("< $file");
+ next unless $sf;
+ my $line;
+ sysread $sf, $line, 256;
+
+ # binary executable
+ if ($line && $line =~ /^\177ELF.\x01.\x09.{8}\x02\0/) {
+ my $fixable = fixable_binary($file, $pkg_name);
+ return 0 unless defined $fixable;
+ push @$binaries, $file if $fixable;
+ # shared library - can prevent us from being able to upgrade
+ } elsif ($line && $line =~ /^\177ELF.\x01.\x09.{8}\x03\0/) {
+ return 0 unless fixable_shared_lib($file, $pkg_name);
+ } elsif ($line && $line =~ m<^\s*#!\s*[\w/]+perl($fuzzy_source)\b>) {
+ print STDERR "- $pkg_name: fixable script $file\n" if $debug;
+ push @$scripts, $file if $1 ne $target;
+ }
+ main::progress();
+ }
+}
+
+#
+my $db = FreeBSD::Package::DB->new;
+my ($fixed, $skipped, $tot_moved, $tot_modified) = (0,0,0,0);
+while (my $pkg = $db->next) {
+ my @lines;
+ my $new_md5;
+ my ($adjusted, $moved, $modified) = (0,0,0);
+
+ my $pkg_name = $pkg->name;
+ if (@tmpl) {
+ my $ok;
+ for (@tmpl) {
+ if ($pkg_name =~ /^$_/) {
+ $ok = 1;
+ last;
+ }
+ }
+ next unless $ok;
+ }
+
+ unless (might_need_to_fix($pkg)) {
+ $skipped++;
+ print STDERR "- Skipping $pkg_name, it does not depend on perl\n" if $debug;
+ next;
+ }
+
+ my (@binaries_to_fix, @scripts_to_fix);
+ if (cannot_be_fixed($pkg, \@binaries_to_fix, \@scripts_to_fix)) {
+ $skipped++;
+ next;
+ }
+ if ($debug) {
+ print STDERR "- $pkg_name: ", scalar(@binaries_to_fix), " binaries to fix\n" if @binaries_to_fix;
+ print STDERR "- $pkg_name: ", scalar(@scripts_to_fix), " scripts to fix\n" if @scripts_to_fix;
+ }
+ my %binaries = map { $_ => 1 } @binaries_to_fix;
+ my %scripts = map { $_ => 1 } @scripts_to_fix;
+
+ my $prefix = "";
+ my $pcnt = 0;
+ for ($pkg->lines) {
+ if (/^([^@]\S+)\s*$/) {
+ my $from = "$prefix/$_";
+ local $_; # we'll need it later
+ $new_md5 = "";
+ unless (-l $from) { # skip symlinks
+ if ($binaries{$from}) {
+ $new_md5 = fix_binary($from, $target);
+ } elsif ($scripts{$from}) {
+ $new_md5 = fix_script($from, $target);
+ }
+ $modified++ if $new_md5;
+ }
+ my $to = $from;
+ if ($to =~ s|/perl5/$fuzzy_source/|/perl5/$target/|g or $to =~ s|/perl5/site_perl/$fuzzy_source/|/perl5/site_perl/$target/|g) {
+ if ($to ne $from) {
+ my $dir = $to;
+ $dir =~ s|/[^/]+$||;
+ main::progress();
+ unless ($dry_run) {
+ if (mkdir_recur($dir)) {
+ move($from, $to);
+ } else {
+ push @errors, " could not move $from to $to";
+ }
+ }
+ $moved++;
+ print STDERR "- move: $from => $to\n" if $debug;
+ }
+ }
+ } elsif (/^\@comment\s+MD5:[\da-f]+\s*$/ && $new_md5) {
+ s|MD5:(\S+)|MD5:$new_md5|;
+ $new_md5 = "";
+ } else {
+ $new_md5 = "";
+ }
+ if (/^\@cwd\s+(\S+)\s*$/) {
+ $prefix = $1;
+ } elsif (/^\@pkgdep\s+perl-($fuzzy_source)\S*\s*$/) {
+ if ($target ne $1) {
+ my $perlver = $1;
+ s|perl-\Q$perlver\E|perl-$target|;
+ }
+ }
+ my $old = $_;
+ if (s|/perl5/$fuzzy_source/|/perl5/$target/|g || s|/perl5/site_perl/$fuzzy_source/|/perl5/site_perl/$target/|g) {
+ if ($old ne $_) {
+ $adjusted++;
+ print STDERR "- adjust: $_\n" if $debug;
+ }
+ }
+ push @lines, $_;
+ main::progress() if $pcnt++ % 250 == 0;
+ }
+ unless ($dry_run) {
+ $pkg->lines(@lines);
+ $pkg->write_back;
+ }
+ $fixed++ if $moved || $modified || $adjusted;
+ $tot_modified += $modified;
+ $tot_moved += $moved;
+ print "$pkg_name: $moved moved, $modified modified, $adjusted adjusted\n";
+}
+print "\n---\n";
+print "Fixed $fixed packages ($tot_moved files moved, $tot_modified files modified)\n";
+print "Skipped $skipped packages\n";
+if (@errors) {
+ print "\n**** The script has encountered following problems:\n";
+ for (@errors) {
+ print "$_\n";
+ }
+ print "\n--- Repeating summary:\n";
+ print "Fixed $fixed packages ($tot_moved files moved, $tot_modified files modified)\n";
+ print "Skipped $skipped packages\n";
+}
+if (@notes) {
+ print "\n**** In addition, please pay attention to the following:\n";
+ for (@notes) {
+ print "$_\n";
+ }
+ print "\n--- Repeating summary:\n";
+ print "Fixed $fixed packages ($tot_moved files moved, $tot_modified files modified)\n";
+ print "Skipped $skipped packages\n";
+}
diff --git a/lang/perl5.14/files/use.perl b/lang/perl5.14/files/use.perl
index 57e1acde0bc..eca7811f3a8 100644
--- a/lang/perl5.14/files/use.perl
+++ b/lang/perl5.14/files/use.perl
@@ -34,9 +34,9 @@ if [ "x$this" = "xuse.perl" ]; then
need_cleanup_make_conf=yes
need_cleanup_manpath=yes
else
- echo 'Usage:
- $0 port -> /usr/bin/perl is the perl5 port
- $0 system -> /usr/bin/perl is the system perl'
+ echo "Usage:
+ ${0##*/} port -> /usr/bin/perl is the perl5 port
+ ${0##*/} system -> /usr/bin/perl is the system perl"
exit 2;
fi
else
@@ -77,14 +77,14 @@ link_list="
pod2man
pod2text
s2p
- splain"
+ splain
+ suidperl"
if [ $osreldate -ge 500036 ] ; then
link_list=""
fi
special_link_list="
perl
- perl5
- suidperl"
+ perl5"
do_remove_links()
{
@@ -130,11 +130,11 @@ do_create_links()
for binary in $special_link_list
do
if [ -f "/usr/bin/$binary" ] ; then
- echo " Removing /usr/bin/$binary"
+ echo " Backing up /usr/bin/$binary as /usr/bin/$binary.freebsd"
+ /bin/mv -f "/usr/bin/$binary" "/usr/bin/$binary.freebsd"
fi
bin=`echo $binary | /usr/bin/sed -e 's!perl5!perl!'`
- bin=`echo $bin | /usr/bin/sed -e 's!suidperl!sperl!'`
- if [ -e "/usr/bin/$binary.XXX" ] ; then
+ if [ -e "/usr/bin/$binary" ] ; then
echo " *** /usr/bin/$binary is still there, which should not happen"
elif [ -e "$PKG_PREFIX/bin/${bin}%%PERL_VERSION%%" ] ; then
echo " Symlinking $PKG_PREFIX/bin/${bin}%%PERL_VERSION%% to /usr/bin/$binary"
@@ -185,6 +185,10 @@ do_base_system_perl()
else
echo " *** $bin is NOT there, nothing to restore"
fi
+ if [ -f "/usr/bin/$binary.freebsd" ] ; then
+ echo " Removing backup copy /usr/bin/$binary.freebsd"
+ rm -f "/usr/bin/$binary.freebsd"
+ fi
fi
done
echo "Done."