###############################################################################
{ package RecycleBin;
  use P;
  use Cwd;
  use PathCat;
  my $dirsep = &PathCat::_fs_path_sep;

  sub recycle ($) {
    state $cwd//= getcwd();
    my $path = $_[0];

    if (substr $path, 0, 1 ne $dirsep) {
      $path =~ s{^(?:./)*}{};
      $path =~ s{(?:/.)*$}{};
      $path = pathcat($cwd, $path);
    }
    my $dev;
    while (1) {
      my $dev = (stat $path)[0];
      Pe "path=%s, dev=%s", $path, $dev;
      $dev && last;
    }
    my ($dh, $dl) = ($dev >> 8, $dev & 0xff); #line 251 in prog

    #Pe "file %s on dev %s,%s, \N{U+83}\n", $path, $dh, $dl;

    my $partname;
    {
      open(my $ph, "<", "/sys/dev/block/$dh:$dl/dm/name") ||
        die "can't open volume name: $!\n";
      $partname = <$ph>;
      chomp $partname;
    }

    #Pe "name %s \N{U+83};", $partname;
    my $mnt_pnt;
    {
      my $mh;
      open($mh, "<", "/proc/mounts") or die "Can't open mount table: $?\n";
      my @table = <$mh>;
      my $qpn   = quotemeta($partname);
      my @mps   = grep m{$qpn}, @table;
      if (@mps < 1) {
        die "Cannot find $partname in mount table";
      }
      $mnt_pnt = (split /\s+/, $mps[0])[1];
      chomp $mnt_pnt;
    }
    my $recycle_bin;
    if (!-d ($recycle_bin = pathcat($mnt_pnt, ".recycle"))) {
      mkdir $recycle_bin,
        1777 || die "Cannot create recycle bin under mount $mnt_pnt: $!";

      chmod 1777, $recycle_bin || die "Cannot set correct mode:$!";
    }

    $_ = $path;
    my @cmd = qw( cp -aflx --parents --strip-trailing-slashes );
    push(@cmd, $_, $recycle_bin);
    my $status = system @cmd;
    $status >>= 8; $status &= 0xf;
    if ($! = $status) {
      Pe "Could not link %s into %s", $_, $recycle_bin;
    } else {
      unlink $_ or Pe "Could not finish move (unlink old file) of %s", $_;
    }
  } ## end sub recycle ($)
  1;
}

##</code><code>##

Read 12161 rpm names.
Use 9 procs w/1353 items/process
#pkgs=10161, #deletes=2000, total=12161
Recycling 2000 duplicates...path=/Share/suse/distribution/12.1/repo/oss/suse/test2/libgtk-2_0-0-2.24.7-2.3.1.x86_64.rpm, dev=65032
Use of uninitialized value $dev in right bitshift (>>) at /home/law/bin/remove-oldver-rpms-in-dir.pl line 251.

##</code><code>##

{  package PathCat; 
  use warnings; use strict;
  use 5.12.0;
  our @ISA=qw(Exporter);
  our @EXPORT=qw{pathcat Set_sep($) Fs_path_sep() pathcat(@)};
  use Exporter;
  our $_sep = '/';

  sub Set_sep ($) { $_sep = $_[0]; }
  sub Fs_path_sep () { $_sep }
  sub _fs_path_sep() { $_sep } 

  sub pathcat(@) {
    my $lval;
    shift while (! defined $_[0] ) and @_>=1;
    defined $_[0] ? (                   
      @_ >= 1 ? 
        $_[0] . (
          ( length ($lval=&path_cat($_[1], @_[2 .. $#_ ]))  and
            length $_[0] and  $_[0] ne _fs_path_sep ) ? 
          _fs_path_sep : '' ) . $lval : 
        $_[0]
        ) : $_[1] // ''
  }
  sub path_cat(@) { goto &pathcat } #old name compat

1;};