#!/usr/bin/perl -w

# include perl packages
use strict;
use warnings;
use diagnostics;

use Tk;
use Tk::FileSelect;
use File::Basename;
use Cwd;

my $nr = @ARGV;
my $verbose = 0;

if ($nr < 1) {
  warn "$0 called with just $nr+1 arguments\n";
  usage();
  exit();
}

my $dir = $ARGV[0];
if (-f $dir) {
	$dir = dirname($dir);
}

my $top = MainWindow->new;
$top->title("MaPiVi Plugin check dir");

my @emptyFiles  = getEmptyFiles ($dir);
my @brokenLinks = getBrokenLinks($dir);

$top->Label(-text => "There are ". scalar @emptyFiles." empty files and ".scalar @brokenLinks." broken links in $dir")->pack();

my $ce = 0;
my $cb = 0;

if (@emptyFiles > 0) {
  $top->Button(-text => "remove empty files", -command => sub {
				 foreach (@emptyFiles) {
				   if ( unlink("$dir/$_") != 1) { # unlink returns the number of successfull removed files
					 $top->messageBox(-icon => 'warning', -message => "Could not delete file \"$_\": $!",
									  -title   => "Error", -type => "OK");
				   }
				   else { $ce++; }
				 }
				 print "removed $ce empty files\n";
			   })->pack();
}

if (@brokenLinks > 0) {
  $top->Button(-text => "remove broken links", -command => sub {
				 foreach (@brokenLinks) {
				   if ( unlink("$dir/$_") != 1) { # unlink returns the number of successfull removed files
					 $top->messageBox(-icon => 'warning', -message => "Could not delete file \"$_\": $!",
									  -title   => "Error", -type => "OK");
				   }
				   else { $cb++; }
				 }
				 print "removed $ce broken links\n";
			   })->pack();
}

$top->Button(-text => "Exit", -command => \&exit)->pack();

$top->MainLoop;

##############################################################
# usage
##############################################################
sub usage {
  my $prog = basename($0);
  print "\nUsage: $prog directory|file\n\n";
  print "This is a example plugin for mapivi (see http://mapivi.de.vu)\n";
  print "It will check, if there are some empty files or\n";
  print "broken links in the given directory and ask to\n";
  print "remove them.\n";
  print "Author:  Martin Herrmann <martin-herrmann\@gmx.de>\n";
  print "License: GNU General Public License, version 2\n";
}

##############################################################
# getEmptyFiles - returns a list of empty files
##############################################################
sub getEmptyFiles {

  my $dir = shift;
  print "  getEmptyFiles: in $dir\n" if $verbose;
  my @fileDirList = readDir($dir);
  my @fileList;
  foreach (@fileDirList) {
	# put only files which are empty into the filelist
	push @fileList, $_ if (-z "$dir/$_");
  }
  return @fileList;
}

##############################################################
# getBrokenLinks - returns a list of broken links
##############################################################
sub getBrokenLinks {

  my $dir = shift;
  print "  getBrokenLinks: in $dir\n" if $verbose;
  my @fileDirList = readDir($dir);
  my @fileList;
  foreach (@fileDirList) {
	if (-l "$dir/$_") {
	  my $real = getLinkTarget("$dir/$_");
	  print "$_ links to $real\n" if $verbose;
	  if (!-f $real) {
		print "$real does not exists!\n" if $verbose;
		# put only files which are empty into the filelist
		push @fileList, $_;
	  }
	}
  }
  return @fileList;
}

##############################################################
# readDir - reads the contents of the given directory
##############################################################
sub readDir {

  my $dir = shift;

  if (! -d $dir) {
	warn "readDir: $dir is no dir!: $!";
	return 0;
  }

  my @fileDirList;

  # open the directory
  if (!opendir ACTDIR, "$dir") {
	warn "Can't open directory $dir: $!";
	return 0;
  }

  # show no files starting with a '.', but '..'
  @fileDirList = grep /^(\.\.)|^[^\.]+.*$/, readdir ACTDIR;

  closedir ACTDIR;

  return @fileDirList;
}

##############################################################
# getLinkTarget - returns the file a link is pointing to
#                 input (directory, link) or (dirlink) where
#                 dirlink consists of directory and link
#                 works with relative and absolute links
##############################################################
sub getLinkTarget {
  my ($dir, $link);
  if (@_ == 2) {
	$dir  = shift;
	$link = shift;
  }
  elsif (@_ == 1) {
	$dir  = dirname($_[0]);
	$link = basename($_[0]);
  }
  else {
	warn "getLinkTarget: wrong # of parameters!";
	return "";
  }
  # change first to the start dir (to handle relative links)
  return "" if !changeDir($dir);
  my $linktargetfile = readlink $link;
  my $linktargetdir  = dirname  $linktargetfile;
  # change to link target, this should now work for relative and absolute links
  return "" if !changeDir($linktargetdir);
  # get the current dir
  my $cwd = cwd();
  $linktargetfile = $cwd."/".basename($linktargetfile);
  return $linktargetfile;
}

##############################################################
# changeDir
##############################################################
sub changeDir {
	my $newDir = shift;
	return 0 unless defined $newDir;
	if ( !chdir $newDir ) {
		my $dialog = $top->Dialog( -title => "Changing to $newDir directory failed",
								  -text => "Can't change to $newDir directory: $!",
								  -buttons => ["OK"]);
		$dialog->Show();
		warn "Can't change to $newDir directory: $!";
		return 0;
	}
	return 1;
}


# Tell Emacs that this is really a perl script
# Local Variables:
# mode:perl
# End:
