#! /usr/bin/perl -w # # fixlinks - script to make symlinks compliant to Debian policy # # Copyright 2000, Stefan Hornburg # # This program is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later # version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public # License along with this program; if not, write to the Free # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA. use strict; use File::Find; find (\&fixlinks, shift); sub fixlinks { my $direction; return unless -l $_; unless ($direction = readlink ($_)) { die "$0: Bogus symbolic link $_: $!\n"; } if ($direction =~ s%^/usr%..%) { unlink ($_) || die "$0: Couldn't remove symbolic link $_: $!\n"; symlink ($direction, $_) || die "$0: Couldn't create symbolic link $_: $!\n"; } }