# ScriptClient.pm
#
# Talk to the NASD scriptable client
#
# Author: Nat Lanza
#
# Copyright (c) of Carnegie Mellon University, 1999.
#
# Permission to reproduce, use, and prepare derivative works of
# this software for internal use is granted provided the copyright
# and "No Warranty" statements are included with all reproductions
# and derivative works. This software may also be redistributed
# without charge provided that the copyright and "No Warranty"
# statements are included in all redistributions.
#
# NO WARRANTY. THIS SOFTWARE IS FURNISHED ON AN "AS IS" BASIS.
# CARNEGIE MELLON UNIVERSITY MAKES NO WARRANTIES OF ANY KIND, EITHER
# EXPRESSED OR IMPLIED AS TO THE MATTER INCLUDING, BUT NOT LIMITED
# TO: WARRANTY OF FITNESS FOR PURPOSE OR MERCHANTABILITY, EXCLUSIVITY
# OF RESULTS OR RESULTS OBTAINED FROM USE OF THIS SOFTWARE. CARNEGIE
# MELLON UNIVERSITY DOES NOT MAKE ANY WARRANTY OF ANY KIND WITH RESPECT
# TO FREEDOM FROM PATENT, TRADEMARK, OR COPYRIGHT INFRINGEMENT.
#

package NASD::PdriveClient;

use NASD::Client;
use strict;
use vars qw( @ISA );

@ISA = qw( NASD::Client );

my $VERSION = '1.00';
my $CLIENT_PROG = "utils/script_client/nasd_script_client";

sub new {
  my ($class, %args) = @_;

  my $self = bless $ISA[0]->new(version     => $VERSION,
				client_prog => $CLIENT_PROG),
				  (ref($class) || $class);
  $self->_init;

  if (defined($args{drive})) { $self->bind($args{drive}); }

  return $self;
}


sub _cmd_unimp {
  my ($self, $command, @args) = @_;

  return (0, "Function $command not implemented", undef);
}
  

sub _cmd_generic {
  my ($self, $command, $nargs, $usage, @args) = @_;

  return(0, "usage: $command $usage", undef)
    if (defined $nargs and @args != $nargs);

  $self->send_command(uc $command, @args);

  my ($rc, $response) = $self->get_response();

  return ($rc, $response, undef);
}


sub bind {
  my ($self) = shift;
  my ($rc, $response) = $self->_cmd_generic("bind", 1, "<drivename>", @_);
  return ($rc, $response, undef);
}

sub unbind {
  my ($self) = shift;
  my ($rc, $response) = $self->_cmd_generic("unbind", 0, "", @_);
  return ($rc, $response, undef);
}


sub create {
  my ($self) = shift;
  my ($rc, $response) =
    $self->cmd_generic("create", 3, "<partnum> <protection> <password>", @_);

  return ($rc, $response, undef) unless $rc;

  my ($ok, $objno) = split /\n/, $response;
  return ($rc, "$ok\n", $objno);
}


sub remove {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("remove", 4,
			"<identifier> <partnum> <protection> <password>", @_);
  return ($rc, $response, undef);
}


sub getattr {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("getattr", 4,
			"<identifier> <partnum> <protection> <password>", @_);
  return ($rc, $response, undef) unless $rc;
  
  my %attr; my $ok;
  
  ($ok,
   $attr{block_preallocation},
   $attr{blocks_used},
   $attr{block_size},
   $attr{av},
   $attr{object_len},
   $attr{attr_modify_time},
   $attr{object_modify_time},
   $attr{object_create_time},
   $attr{fs_attr_modify_time},
   $attr{fs_object_modify_time},
   $attr{layout_hint}) = split /\n/, $response;

  if ($ok =~ /^OK\s+DATA\s+([0-9]+)/) {
    my $size = $1;
    $attr{fs_specific} = $self->get_data($size);
  }

  return ($rc, "OK\n", \%attr);
}


sub setattr {
  my ($self) = shift;
  $self->_cmd_unimp("setattr");
}


sub initialize {
  my ($self) = shift;
  my ($rc, $response) = $self->_cmd_generic("initialize", 1, "<password>", @_);
  return ($rc, $response, undef);
}


sub listpart {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("listpart", 3,
			"<partnum> <protection> <password>", @_);
  return ($rc, $response, undef) unless $rc;
  
  my ($ok, @objlist) = split /\n/, $response;
  return ($rc, "$ok\n", \@objlist);
}


sub partition {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("partition", 4,
			"<partnum> <blocks> <protection> <password>", @_);
  return ($rc, $response, undef);
}


sub driveinfo {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("driveinfo", 2, "<protection> <password>", @_);
  
  return ($rc, $response, undef) unless $rc;

  my %dhash; my $ok;
  
  ($ok, $dhash{max_parts}, $dhash{blocksize}, $dhash{num_parts},
   $dhash{num_blocks}, $dhash{blocks_allocated}) = split /\n/, $response;
  
  return ($rc, "$ok\n", \%dhash);
}


sub partinfo {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("partinfo", 3,
			"<partnum> <protection> <password>", @_);

  return ($rc, $response, undef) unless $rc;

  my %phash; my $ok;

  ($ok, $phash{first_obj}, $phash{num_obj}, $phash{part_size},
   $phash{blocks_used}, $phash{blocks_allocated}, $phash{max_objs},
   $phash{blocksize}, $phash{min_protection}) = split /\n/, $response;

  return ($rc, "$ok\n", \%phash);
}


sub eject {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("eject", 4,
			"<identifier> <partition> <protection> <password>",
			@_);
  return ($rc, $response, undef);
}


sub flush {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("flush", 4,
			"<identifier> <partition> <protection> <password>",
			@_);
  return ($rc, $response, undef);
}


sub sync {
  my ($self) = shift;
  my ($rc, $response) = $self->_cmd_generic("sync", 0, "", @_);
  return ($rc, $response, undef);
}


sub noop {
  my ($self) = shift;
  my ($rc, $response) = $self->_cmd_generic("noop", 0, "", @_);
  return ($rc, $response, undef);
}


sub null {
  my ($self) = shift;
  my ($rc, $response) = $self->_cmd_generic("null", 0, "", @_);
  return ($rc, $response, undef);
}


sub read {
  my ($self) = shift;
  my ($rc, $response) =
    $self->_cmd_generic("read", 6,
			"<partnum> <identifier> <offset> <len> <protection> <password>",
			@_);
  # XXXXXX bad
  return ($rc, $response, undef);
}


sub tread {
  my ($self) = shift;
  $self->_cmd_unimp("tread");
}


sub write {
  my ($self) = shift;
  $self->_cmd_unimp("write");
}


sub rangeread {
  my ($self) = shift;
  $self->_cmd_unimp("rangeread");
}


sub rangetread {
  my ($self) = shift;
  $self->_cmd_unimp("rangetread");
}


sub rangewrite {
  my ($self) = shift;
  $self->_cmd_unimp("rangewrite");
}

1;
