eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w
#
# Trashcan application for Rox-Filer.
# Based on dfm-trashcan.tcl, obtained from Ethan's code kitchen:
# http://www.cs.columbia.edu/~etgold/software/mycode.html
#
# Rewritten in Perl by Diego Zamboni, December 2000.
# $Id: AppRun,v 1.16 2001/03/09 00:49:18 zamboni Exp $

use strict;
use File::Basename;
use File::Copy;
use File::Path;
use vars qw(
	    $Trashcan
	    $AppDir
	    $Rox
	    $RoxUpdate
	    @updatelist
	    %TrashIcons
	    $BlinkTrashcan
	    $BlinkPeriod
	    $UseEmptyProgram
	   );

# Get the directory for the application
$AppDir=dirname($0);
push @updatelist, $AppDir;

######################################################################
# Config section

# Pick the one you like, or make your own.
$Trashcan="$ENV{HOME}/.trashcan";
#$Trashcan="$AppDir/Trashcan";

# How to run rox-filer
$Rox="rox";

# If your rox doesn't support the -x flag, either update or set this
# to undef.
$RoxUpdate=1;

# Icons to use. Names have to exist inside the Application directory.
%TrashIcons = ( 'empty'	=> 'AppIconEmpty.xpm',
		'full'	=> 'AppIconFull.xpm',
# You can define these if you want different icons - see flip_icon()
#		'working1'	=> 'AppIconEmpty.xpm',
#		'working2'	=> 'AppIconFull.xpm',
	      );

# Experimental feature: switch the app icon between "empty" and "full"
# (or between "working1" and "working2" if they are defined in %TrashIcons
# above) when the Empty operation takes too long, to let the user know
# that something is happening.
# This uses signals - use at your own risk.
# Disabled by default - change to 1 to enable.
$BlinkTrashcan = 1;

# How frequently to blink the icon (in seconds) if $BlinkTrashcan is true
$BlinkPeriod = 5;

# If true, write an "Empty trashcan" program to the trashcan whenever it
# is full. This is not necessary if you have the latest version of
# ROX-Filer, which supports AppMenus, because then you can just right-click
# on the trashcan and select "Empty trashcan".
$UseEmptyProgram = undef;

# End config section
######################################################################

# Main program

# Create trashcan dir if it doesn't exist
check_trashdir();
push @updatelist, $Trashcan;

# If no arguments, just update the icon and open the trashcan
unless (@ARGV) {
  update_trash();
  open_trash();
  exit;
}

# We recognize two special arguments. These are not normally intended
# to be used together, hence the primitive way of checking them.
if ($ARGV[0] && $ARGV[0] eq '--open') {
  shift @ARGV;
  open_trash();
}
if ($ARGV[0] && $ARGV[0] eq '--empty') {
  shift @ARGV;
  empty_trash();
}

# Move things to the trashcan, renaming them if necessary.
start_blink();
foreach (@ARGV) {
  # In case DnD is including hostnames
  s@^file://[^/]+/@/@;
  my $base=basename($_);
  my $new="$Trashcan/$base";
  if (-e $new) {
    my $number=1;
    while (-e "$new.$number") {
      $number++;
    }
    $new.=".$number";
    warn "An item named '$base' already existed in the trashcan, I stored ".
      "the new one as '$base.$number'.\n";
  }
  # First try File::Copy::move...
  if (!move($_, $new)) {
    my $err1=$!;
    # If it fails, try the mv command
    system("mv $_ $new") == 0
      or warn "Could not move $_ to the trashcan: mv returned $?, File::Copy::move said '$err1')\n";
  }
  # Add to the update list
  push @updatelist, $_;
}
stop_blink();

update_trash();

exit;

# Update the icon for the trashcan according to its contents, and create
# the "Empty trash" script if necessary.
sub update_trash {
  my $roxcmd="";
  my $script;
  $roxcmd=roxupdate_cmd(@updatelist) if $RoxUpdate;
  # Remove the trash emptying script if it's there.
  if ($UseEmptyProgram) {
    $script="$Trashcan/ Empty trash";
    unlink($script);
  }
  # Check if the trashcan is not empty
  opendir(TRASH, $Trashcan)
    or die "Error opening Trashcan for checking: $!\n";
  # If it has more than two files (. and ..) it is not empty
  if (readdir(TRASH) && readdir(TRASH) && readdir(TRASH)) {
    if ($UseEmptyProgram) {
      # Create a program that empties the trashcan
      open(FILE, ">$script")
	or die "Error creating script '$script': $!\n";
      print FILE <<EOS;
#!/bin/sh
/bin/rm $AppDir/AppIcon.xpm
/bin/ln -s $AppDir/$TrashIcons{empty} $AppDir/AppIcon.xpm
/bin/rm -rf $Trashcan/*
$roxcmd
EOS
      close(FILE);
      chmod 0700, $script
	or die "Error setting permissions on script '$script': $!\n";
    }
    # Set our program icon to the full trashcan
    set_icon('full');
  } else {
    # Set our program icon to the empty trashcan
    set_icon('empty');
  }
  closedir(TRASH);
  # Tell Rox to update the icons
  roxupdate(@updatelist);
}

# Open the trashcan
sub open_trash {
  system("$Rox $Trashcan");
}

# Create the trashcan directory if it doesn't exist.
sub check_trashdir {
  unless (-d $Trashcan) {
    mkdir $Trashcan, 0755
      or die "Could not create trashcan dir ($Trashcan): $!\n";
  }
}

# Empty the trashcan
sub empty_trash {
  start_blink();
  rmtree($Trashcan);
  stop_blink();
  check_trashdir();
}

# Start blinking the icon
sub start_blink {
  if ($BlinkTrashcan) {
    $SIG{ALRM} = \&flip_icons;
    alarm($BlinkPeriod);
  }
}

# Stop blinking the icon
sub stop_blink {
  if ($BlinkTrashcan) {
    alarm(0);
  }
}

# Blink the trashcan icon between 'working1' (or 'empty' if working1 is
# not defined) and 'working2' (or 'full' if it is not defined).
sub flip_icons {
  if ($TrashIcons{working1}) {
    set_icon('working1');
  }
  else {
    set_icon('empty');
  }
  if ($TrashIcons{working2}) {
    set_icon('working2');
  }
  else {
    set_icon('full');
  }
  if ($BlinkTrashcan) {
    alarm($BlinkPeriod);
  }
}

# Set the trashcan to a certain icon, empty by default.
# If the icon type requested doesn't exist, it does nothing.
sub set_icon {
  my $type=shift||"empty";
  return unless (exists($TrashIcons{$type}));
  unlink "$AppDir/AppIcon.xpm";
  link "$AppDir/$TrashIcons{$type}", "$AppDir/AppIcon.xpm"
    or die "Error linking new AppIcon.xpm: $!\n";
  roxupdate($AppDir);
}

# Tell Rox-Filer to update a list of files or directories, given as
# arguments. Only does it if $RoxUpdate is true.
sub roxupdate {
  if ($RoxUpdate) {
    if (@_) {
      my $updatelist=roxupdate_cmd(@_);
      system("$Rox $updatelist");
    }
  }
}

# Returns the command necessary to update a list of files or directories,
# given as arguments.
sub roxupdate_cmd {
  if (@_) {
    return " -x ".join(" -x ", @_);
  }
  else {
    return "";
  }
}
