#!/usr/bin/perl -w

use strict;
use Cwd;
use Getopt::Std;

# $opt_b - bindir
# $opt_h - help
# $opt_i - infodir
# $opt_m - mandir
# $opt_v - verbose
use vars qw($opt_b $opt_h $opt_i $opt_m $opt_v);

$| = 1;


getopts('b:hi:m:v');
usage(0) if $opt_h;

if ($#ARGV != 0)
{
  print(STDERR "E: none or too many actions specified\n\n");
  usage(1);
}

my $action = $ARGV[0];
my $action_len = length($action);

# This is the place to set a minimum length for the <action> keyword
unless ($action_len >= 1)
{
  print(STDERR "E: <action> argument too short\n\n");
  usage(1);
}

# Valid actions
my @actions = ('check', 'symlink', 'unlink');

# Verify action validity
my $err = 1;
foreach my $act (@actions)
{
  if ($action eq substr($act, 0, $action_len))
  {
    $err = 0;
    $action = $act;
    $action_len = length($action);
    last;
  }
}
if ($err)
{
  print(STDERR "E: invalid <action> argument \"$action\"\n\n");
  usage(1);
}

# Setup default directory names
my $prefix  = "/usr/local";
my $bindir  = "$prefix/cris";
my $infodir = "$prefix/info";;
my $mandir  = "$prefix/man";;
if ($opt_b)
{
  $bindir = $opt_b;
}
if ($opt_i)
{
  $infodir = $opt_i;
}
if ($opt_m)
{
  $mandir = $opt_m;
}

# Setup target (build) directory names
my $here = cwd();
my $bindir_tgt  = "$here/debian/cris-dist" . $bindir;
my $infodir_tgt = "$here/debian/cris-dist" . $infodir;
my $mandir_tgt  = "$here/debian/cris-dist" . $mandir;

if ($opt_v)
{
  print(STDERR "\nI: ", $action, "ing");
  print(STDERR ":\n");
  print(STDERR "I:\tsymlink:\t$bindir\n\ttarget dir:\t$bindir_tgt\n");
  print(STDERR "I:\tsymlink:\t$infodir\n\ttarget dir:\t$infodir_tgt\n");
  print(STDERR "I:\tsymlink:\t$mandir\n\ttarget dir:\t$mandir_tgt\n");
}

$err = 0;
if ($action eq $actions[0])
{
  # action 'check' here
  print(STDERR "\n\n");
  $err = 1 unless chk_this($bindir, $bindir_tgt);
  $err = 1 unless chk_this($infodir, $infodir_tgt);
  $err = 1 unless chk_this($mandir, $mandir_tgt);
}
elsif ($action eq $actions[1])
{
  # action 'symlink' here
  $err = 1 unless symlnk_this($bindir, $bindir_tgt);
  $err = 1 unless symlnk_this($infodir, $infodir_tgt);
  $err = 1 unless symlnk_this($mandir, $mandir_tgt);
}
elsif ($action eq $actions[2])
{
  # action 'unlink' here
  $err = 1 unless unlnk_this($bindir, $bindir_tgt);
  $err = 1 unless unlnk_this($infodir, $infodir_tgt);
  $err = 1 unless unlnk_this($mandir, $mandir_tgt);
}
else
{
  # Should never reach this point
  die "F: internal error,";
}


exit($err);


sub usage
{
  my ($ret_val) = @_;
  my $pgm = $0;

  $pgm =~ s,^.*/([^/]+)$,$1,;
  print(STDERR "Usage: ./$pgm\t[-b <bindir>] [-i <infodir>] [-m <mandir>]
\t\t\t\t[-h] [-v] <action>
where:
\t<action>\targument value may be one of the following keywords:
\t\t\tcheck, symlink or unlink
options:
\t-b <bindir>\tbindir path (default /usr/local/cris)
\t-h\t\tthis help
\t-i <infodir>\tinfodir path (default /usr/local/info)
\t-m <mandir>\tmandir path (default /usr/local/man)
\t-v\t\tverbose
");

  exit($ret_val);
}


sub chk_this
{
  my ($lnk_src, $lnk_tgt) = @_;
  my $success = 1;

  if (-l $lnk_src)
  {
    unless (readlink($lnk_src) eq $lnk_tgt)
    {
      $success = 0;
    }
  }
  else
  {
    $success = 0;
  }

  unless ($success)
  {
    print(STDERR "E: $lnk_src should be a symlink pointing to\n",
	  "   $lnk_tgt\n");
  }

  return $success;
}


sub symlnk_this
{
  my ($lnk, $lnk_tgt) = @_;
  my $success = 1;
  my $orig = "$lnk.orig";

  if (-e $orig)
  {
    $success = 0;
    print(STDERR "E: $orig already exists\n");
  }
  else
  {
    unless (rename($lnk, $orig))
    {
      my $msg = $!;

      $success = 0;
      print(STDERR "E: failed moving $lnk to $orig\n");
      print(STDERR "E: $msg\n");
    }
    else
    {
      print(STDERR "\nI: $lnk moved to $orig\n") if $opt_v;
    }
  }

  if ($success)
  {
    # symlink function won't symlink to an unexisting directory,
    # so we need to do another ugly hack :(
    my $chopped_tgt = $lnk_tgt;
    $chopped_tgt =~ s,$here/,,;
    my @d_list = split('/', $chopped_tgt);
    my $dir_ws = $here;
    my @dcre_list;

    foreach my $d (@d_list)
    {
      $dir_ws = "$dir_ws/$d";
      unless (-d "$dir_ws")
      {
	if (mkdir("$dir_ws", 0755))
	{
	  push(@dcre_list, "$dir_ws");
	  print(STDERR "I: $dir_ws created\n") if $opt_v;
	}
	else
	{
	  $success = 0;
	  print(STDERR "E: failed creating directory $dir_ws\n");
	}
      }
    }

    if ($success)
    {
      if (symlink($lnk_tgt, $lnk))
      {
	if ($#dcre_list > -1)
	{
	  @dcre_list = reverse(@dcre_list);
	  foreach my $d (@dcre_list)
	  {
	    unless (rmdir($d))
	    {
	      $success = 0;
	      print(STDERR "E: failed removing directory $d\n");
	      last;
	    }
	    else
	    {
	      print(STDERR "I: $d removed\n") if $opt_v;
	    }
	  }
	}
      }
      else
      {
	my $msg = $!;

	# Back off
	rename($orig, $lnk) or
	  die "F: failed backing off (moving $orig to $lnk),";

	$success = 0;
	print(STDERR "E: failed symlink creation $lnk pointing to\n",
	      "   $lnk_tgt\n");
	print(STDERR "E: $msg\n");
      }
    }
  }

  return $success;
}


sub unlnk_this
{
  my ($lnk) = @_;
  my $success = 1;

  print(STDERR "\n") if $opt_v;

  unless (-l $lnk)
  {
    $success = 0;
    print(STDERR "E: \"$lnk\" is not a symlink\n");
  }
  else
  {
    my $orig = "$lnk.orig";

    unless (-d $orig)
    {
      $success = 0;
      print(STDERR "E: directory \"$orig\" not found\n");
    }
    else
    {
      unless (unlink($lnk))
      {
	$success = 0;
	print(STDERR "E: symlink \"$lnk\" could not be unlinked\n");
      }
      else
      {
	print(STDERR "I: \"$lnk\" unlinked\n") if $opt_v;

	unless (rename($orig, $lnk))
	{
	  my $msg = $!;

	  $success = 0;
	  print(STDERR "E: failed moving $orig to $lnk\n");
	  print(STDERR "E: $msg\n");
	}
	else
	{
	  print(STDERR "I: $orig moved to $lnk\n") if $opt_v;
	}
      }
    }
  }

  return $success;
}
