#!/usr/bin/perl

$debug = 0;
&debug_init;

$MTX = "/usr/sbin/mtx";

if(!$ENV{TAPE}){
    &debug("setting TAPE to /dev/tape");
    $ENV{TAPE} = "/dev/tape";
}

# initialize the state

@slots = (1..6);
$current_slot = 0;
$tape_device = "/dev/tape";

&changer_init();

&debug("main::current slot: $current_slot");

if($ARGV[0] eq "-eject"){
    &debug("main::got eject request");
    # eject is a no-op right now...
}

if($ARGV[0] eq "-info"){
    &debug("main::got info request");
    &print_info();
    exit(1);
}

if($ARGV[0] eq "-reset"){
    &debug("main::got changer reset request");
    &reset_changer();
}

if($ARGV[0] =~ /-slot/){
    $slot = $ARGV[1];

    if($slot =~ /^(next|prev|current|first|last)$/){
	&debug("main::got relative position request ($slot)");
	$slot = &get_slot_number($slot);
	&debug("main::translated slot number: $slot");
    }
    
    if($slot !~ /^[0-9]$/){
	&fatal_error("bogus slot number: $slot");
    }

    &change_to_slot($slot);
}

&print_status();


##### subs ########################################

sub debug {
    my $message = shift;
    print DEBUG "$message\n" if $debug;
}

sub changer_init {
    &debug("changer_init::start");
    if(!(@response = `$MTX status`)){
	&fatal_error("couldn't run mtx: $!");
    }

    &debug("changer_init:: @response");

    if($response[0] =~ /full .storage element ([1-6]) loaded/i){
	$current_slot = $1;
	&debug("changer_init::tape loaded: $current_slot");
	return();
    }

    if($response[0] =~ /empty/i) {
	&debug("changer_init::no tape loaded, checking for other tapes...");
	foreach $slot (@response) {
	    if($slot =~ /full/i) {
		$tape_in_changer = 1;
		break;
	    }
	}
	if(!$tape_in_changer) {
	    &debug("changer_init::no tapes in the changer");
	    &fatal_error("no tapes in changer");
	} else {
	    &debug("changer_init::loading tape 1");
	    &run_command("$MTX load 1");
	    $current_slot = 1;
	}
    }
}



sub print_status {
    &debug("print_status::start");
    print "$current_slot $tape_device\n";
    exit(0);
}



sub run_command {
    my $command = shift;
    
    &debug("run_command:: $command");
    system("$command 2> /dev/null");
    if($? != 0) {
	&fatal_error("[$command] returned non zero ($?)");
    }
}



sub print_info {
    print "$current_slot 6 1\n";
    exit(0);
}



sub fatal_error {
    my $error = shift;
    
    print "$current_slot $error\n";
    exit(2);
}



sub reset_changer {
    &debug("reset_changer:: start");
    &change_to_slot(1);
}



sub change_to_slot {
    my $slot = shift;

    &debug("change_to_slot:: $slot");
    if(!&in_range($slot)) {
	&non_fatal_error("slot $slot out of range");
    }

    if($slot == $current_slot){
	return;
    } else {
	&run_command("$MTX unload");
	&run_command("$MTX load $slot");
    }
    
    $current_slot = $slot;
}



sub get_slot_number {
    my $description = shift;

    &debug("get_slot_number: $description");
    if($description eq "first"){
	return(1);
    }

    if($description eq "last"){
	return(6);
    }

    if($description eq "current"){
	return($current_slot);
    }

    # we don't want to destroy $current_slot with post/preincrement
    $slot_index = $current_slot;

    if($description eq "prev"){
	if(&in_range($current_slot)){
	    return((6,1..6,1)[--$slot_index]);
	} else {
	    &non_fatal_error("current slot number out of range: $current_slot");
	}
    }

    if($description eq "next"){
	if(&in_range($current_slot)){
	    return((6,1..6,1)[++$slot_index]);
	} else {
	    &non_fatal_error("current slot number out of range: $current_slot");
	}
    }

    return(0);
}

sub in_range {
    my $slot_num = shift;
    
    &debug("in_range:: $slot_num");
    return(($slot_num <= 6) && ($slot_num >= 1));
}

sub non_fatal_error {
    my $message = shift;

    print "$current_slot $message\n";
    exit 1;
}

sub debug_init {
    return unless $debug;
    open(DEBUG, ">/tmp/x-changer.debug.$$");
    $today = localtime();
    print DEBUG "Date: $today\n";
    print DEBUG "UID: $<\n";
    print DEBUG "EUID: $>\n";
    print DEBUG "PATH: $ENV{PATH}\n";
}

