#!/usr/bin/perl -w
#author: Chris Sincock
#This software is provided as-is and is not guaranteed to be free of defects. Use it only at your own risk.

use Fcntl ':flock';
use Fcntl ':seek';

my $true=1;
my $false=0;
my $force=$false;
my $truncpos=undef;
my $file="";
my $gui=$false;
for my $arg (@ARGV)
{
  if($arg eq "--force")
  {
    $force = $true;
  }
  elsif($arg eq "--gui")
  {
    $gui = $true;
  }
  elsif($arg =~ /^\d+$/)
  {
    $truncpos=$arg;
  }
  elsif(-f $arg)
  {
    $file=$arg;
  }
  else
  {
    &usage();
    die "(unknown argument: $arg";
  }
}
sub domessage()
{
  my $message=shift;
  if($gui)
  {
    system "pgprompt tell MESSAGE='$message'";
  }
  else
  {
    print STDERR $message;
  }
}

system("ls","-lh",$file);

#    print "checking $controlFile\n";
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks)
    = stat($file);

print "current file size is: $size\n";

if(!defined($truncpos))
{
  print "enter the length (in bytes) to truncate the file to...:";
  $truncpos=<STDIN>;
  chomp $truncpos;
  my $message="";
  if(! ($truncpos =~ /^\d+$/))
  {
    $message="the file size entered was the wrong format (not just digits).\n"
      . "You'll have to try again. sorry\n";
  }
  if($truncpos > $size)
  {
    $message="The file is already shorter than where you want to truncate it to!";
  }
  if($message)
  {
    &domessage($message);
    exit 0;
  }
}

my $pc = int($truncpos * 10000.0/ $size)/100.0;

my $warning="About to truncate the file '$file' to length: $truncpos ($pc % of the file)\n"
."Are you sure u wish to truncate it (this is the last warning)!";

my $sure="n";

if(!$gui)
{
  print STDERR $warning. "[y/N]\n";
  $sure=<STDIN>;
  chomp $sure;
}
else
{
  my @result=`pgprompt ask BUTTONS='Truncate/Cancel' CANCELBUTTON=Cancel CANCEL=Cancel MESSAGE="$warning" BUTTONSEP=/`;
  if(@result)
  {
    chomp $result[0];
    $sure=$result[0] =~ /truncate/i  ? "y" : "n";
  }
}

if( ! ($sure eq "y"))
{
    print STDERR "ok, cancelling because you didn't enter 'y'\n";
    exit 0;
}

if(open(TFILE, "+<$file")) #need the + here so the truncate works.
{

    flock(TFILE,LOCK_EX);
    
    print "truncating file\n";
    my $status=seek (TFILE, $truncpos,SEEK_SET);
    if($status != 1)
    {
	print STDERR "Failed seeking! (to position: $truncpos)\n";
	exit 0;
    }
	
    $status = truncate(TFILE,$truncpos);
    print "performed truncate... status was ". ($status ? "OK" : "Failed")."\n";
    system("ls","-lh",$file);
    print STDERR "closing file...\n";
    flock(TFILE,LOCK_UN);
    close TFILE;
    system("ls","-lh",$file);
    print STDERR "(done)\n";
}