--- /dev/null
+#!/usr/bin/perl
+# $Id: trash,v 1.1 1997/08/05 02:23:55 cvsconf Exp $
+
+# Trash utility suite
+# Zygo Blaxell, 96/05/29
+# Version 1.3
+# 'mkdir' command deals with symlinks correctly, and renames non-directories
+# aside.
+
+# Version 1.2
+# Fixed problems with exit status in 'trash' modes.
+
+# Version 1.1, 96/05/03
+# Fixed so it works on Solaris and Perl4
+
+# Version 1.0
+# Finally released...
+
+# Usage: Name this file one of the following:
+
+# trash - 'trash file' moves 'file' into a trash directory.
+# sneaky-trash - trashes file, then creates a symlink to it.
+# placebo-trash - trashes file, then creates a 0-length file with the
+# same permissions.
+# untrash - attempt to recover a file from trash directory.
+# note that if you trash a file with the same name
+# twice, this may not work.
+# lstrash - 'lstrash -RFC' lists contents of all existing trash
+# directories using 'ls -RFC' (or your own flags).
+
+# Environment variables:
+# TRASH_NO_AUTOCONFIG - don't try to use 'df' to find a good place to
+# make trash directories if this is set.
+# TRASH_PREFER - format: directory=value:directory=value:...
+# example: /home/you/.trash=2:/tmp=-2:.trash=-1
+# Sets preference values for directories.
+# Autoconfigured preference values range from 0 to 1.
+# Higher preference values will be used first.
+# A preference value that is non-numeric (such as "off")
+# will prevent the directory from ever being used.
+# TRASH_UMASK - override the default umask for the trashcan directory.
+# The default umask is 077.
+
+# A 'trash directory' is a directory that holds the trash
+# files. This software assumes that you have some other software that
+# will empty this trash directory. If you don't, simply use 'rm -rf'
+# on the trash directory itself. If you want software that deletes
+# the oldest files in a directory hierarchy when disk space drops below
+# a minimum threshold, try my program 'filereaper'.
+
+# CONFIGURATION
+# Edit the 'df' command between `` characters below to be the fastest
+# possible invocation for your system. 'df --no-sync -xnfs' for GNU df.
+
+# Trashcan directory privacy settings - use '077' to deny all access,
+# '027' allow group read access
+# '022' allow world read access
+
+$umask=umask($ENV{'TRASH_UMASK'} || 077);
+
+for $component (split(/\:+/o,$ENV{'TRASH_PREFER'})) {
+ ($dir,$pref)=($component =~ m:^([^=]+)=([^=]+)$:oi);
+ $dir =~ s:/+:/:go;
+ if (defined($pref)) {
+ if (!(-d $dir)) {
+ print STDERR "Warning: TRASH_PREFER refers to $dir, which is not a directory\n";
+ $pref='no';
+ }
+ $free{$dir}=$pref;
+ } else {
+ print STDERR "Warning: Couldn't grok $component in TRASH_PREFER variable\n";
+ }
+}
+
+$userid=getpwuid("$<") || ":$<:";
+$trashdir=".trash.$userid";
+
+# Automatic configuration - comment this out if you don't want it.
+unless ($ENV{'TRASH_NO_AUTOCONFIG'}) {
+ @df=split(/\n/o,`df -k`);
+ for (@df) {
+ ($fs,$blocks,$used,$avail,$cap,$mp)=split(' ',$_);
+ ($dir="$mp/tmp/$trashdir") =~ s:/+:/:go;
+ next if defined($free{$dir});
+ next unless $blocks =~ /^\d+$/o;
+ $created{$dir}=mkdir($dir,0755);
+ next if (-l $dir);
+ next if !(-d _);
+ next if !(-O _);
+ $free{$dir}=$avail;
+ }
+}
+
+foreach (keys(%free)) {
+ delete $free{$_} if ($free{$_} =~ m/^[^\d]*$/o);
+}
+
+@filesystems=sort { $free{$b} <=> $free{$a} } (keys(%free));
+print STDERR "Trash directories in preference order: @filesystems\n";
+
+($curdir=`pwd`) =~ s/\n$//o;
+$curdir='.' unless $curdir =~ m:^/:o;
+
+$attempts=0;
+$successes=0;
+if ($0 =~ /untrash$/oi) {
+ for $arg (@ARGV) {
+ $attempts++;
+ $arg="$curdir/$arg" unless $arg =~ m:^/:o;
+ $arg =~ s:/+$::o;
+ for $fs (@filesystems) {
+ eval {
+ $trasharg="$fs/$arg";
+ $trasharg =~ s:/+:/:go;
+ next unless ((-l $trasharg) || (-e _));
+ print STDERR "$trasharg -> $arg\n";
+ rename($trasharg,$arg) || (system("mv",$trasharg,$arg) && die "mv: exit status $?");
+ $successes++;
+ last;
+ };
+ print STDERR $@ if $@;
+ last unless $@;
+ }
+ }
+} elsif ($0 =~ /lstrash$/io) {
+ exec("ls",@ARGV,@filesystems);
+} else {
+ for $arg (@ARGV) {
+ $attempts++;
+ unless ((-l $arg) || (-e _)) {
+ print STDERR "$arg: not found: $!\n";
+ next;
+ }
+ ($dev,$ino,$mode)=lstat(_);
+ $arg="$curdir/$arg" unless $arg =~ m:^/:o;
+ $arg =~ s:/+$::o;
+ for $fs (@filesystems) {
+ eval {
+ @argcomp=split(m:/+:o,$arg);
+ pop(@argcomp) while $#argcomp>=0 && !length($argcomp[$#argcomp]);
+ $argfile=pop(@argcomp);
+ $argdir=join("/",@argcomp);
+ $trashargdir="$fs/$argdir";
+ $trasharg="$fs/$arg";
+ $trasharg =~ s:/+:/:go;
+ $trashargdir =~ s:/+:/:go;
+ $trashnewarg=$trasharg;
+ $trashnewarg =~ s/(\.(\d+))?$/".".($2+1)/oe while ((-l $trashnewarg) || (-e _));
+ if ($trashnewarg ne $trasharg) {
+ print STDERR "$trasharg -> $trashnewarg\n";
+ rename($trasharg,$trashnewarg) || warn "rename: $trasharg -> $trashnewarg: $!";
+ }
+ eval {
+ unless (! (-l "$trashargdir") && (-d _)) {
+ $path_so_far=($fs =~ m:^/:o) ? '' : '.';
+ for (split(/\/+/o,$trashargdir)) {
+ ($newdir="$path_so_far/$_") =~ s:/+:/:go;
+ $path_so_far=$newdir;
+ next if (! (-l $path_so_far) && (-d _));
+ $trashnewpath=$path_so_far;
+ $trashnewpath =~ s/(\.(\d+))?$/".".($2+1)/oe while ((-l $trashnewarg) || (-e _));
+ if ($trashnewpath ne $path_so_far) {
+ print STDERR "$path_so_far -> $trashnewpath\n";
+ rename($path_so_far,$trashnewpath) || warn "rename: $path_so_far -> $trashnewpath: $!";
+ }
+ print STDERR "mkdir $newdir\n";
+ mkdir($newdir,0700) || die "mkdir $newdir: $!" unless (-d "$newdir/");
+ }
+ }
+ };
+ print STDERR $@ if $@;
+ next if $@;
+ print STDERR "$arg -> $trasharg\n";
+ rename($arg,$trasharg) || (system("mv",$arg,$trasharg) && die "mv: exit status $?");
+ if ($0 =~ /sneaky-trash$/oi) {
+ print STDERR "$arg <- $trasharg\n";
+ symlink($trasharg,$arg) || die "symlink $trasharg <- $arg: $!";
+ } elsif ($0 =~ /placebo-trash$/oi) {
+ print STDERR "touch $arg\n";
+ open(PLACEBO,">>$arg") || die "open $arg: $!";
+ close(PLACEBO);
+ chmod($mode,$arg) || die "chmod $arg: $!";
+ }
+ $successes++;
+ last;
+ };
+ print STDERR $@ if $@;
+ last unless $@;
+ }
+ }
+}
+
+exit(1) if $successes != $attempts;
+exit(0);