view release on metacpan or  search on metacpan

Ace/Local.pm  view on Meta::CPAN

# Changed readsize to be 4k rather than 5k.  Most flavours of UNIX
# have a page size of 4kb or a multiple thereof.  It improves
# efficiency to read an integer number of pages
# -- tim.cutts@incyte.com 08 Sep 1999

use constant READSIZE   => 1024 * 4;  # read 4k units

# this seems gratuitous, but don't delete it just yet
# $SIG{'CHLD'} = sub { wait(); } ;

sub connect {
  my $class = shift;
  my ($path,$program,$host,$port,$nosync) = rearrange(['PATH','PROGRAM','HOST','PORT','NOSYNC'],@_);
  my $args;
  
  # some pretty insane heuristics to handle BOTH tace and aceclient
  die "Specify either -path or -host and -port" if ($program && ($host || $port));
  die "-path is not relevant for aceclient, use -host and/or -port"
    if defined($program) && $program=~/aceclient/ && defined($path);
  die "-host and -port are not relevant for tace, use -path"
    if defined($program) && $program=~/tace/ and (defined $port || defined $host);
  
  # note, this relies on the programs being included in the current PATH
  my $prompt = 'acedb> ';
  if ($host || $port) {
    $program ||= 'aceclient';
    $prompt = "acedb\@$host> ";
  } else {
    $program ||= 'giface';
  }
  if ($program =~ /aceclient/) {
    $host ||= DEFAULT_HOST;
    $port ||= DEFAULT_PORT;
    $args = "$host -port $port";
  } else {
    $path ||= DEFAULT_DB;
    $path = _expand_twiddles($path);
    $args = $path;
  }
  
  my($rdr,$wtr) = (gensym,gensym);
  my($pid) = open2($rdr,$wtr,"$program $args");
  unless ($pid) {
    $Ace::Error = <$rdr>;
    return undef;
  }

  # Figure out the prompt by reading until we get zero length,
  # then take whatever's at the end.
  unless ($nosync) {
    local($/) = "> ";
    my $data = <$rdr>;
    ($prompt) = $data=~/^(.+> )/m;
    unless ($prompt) {
      $Ace::Error = "$program didn't open correctly";
      return undef;
    }
  }

  return bless {
		'read'   => $rdr,
		'write'  => $wtr,
		'prompt' => $prompt,
		'pid'    => $pid,
		'auto_save' => 1,
		'status' => $nosync ? STATUS_PENDING : STATUS_WAITING,  # initial stuff to read
	       },$class;
}

sub debug {
  my $self = shift;
  my $d = $self->{debug};
  $self->{debug} = shift if @_;
  $d;
}

sub DESTROY {
  my $self = shift;
  return unless kill 0,$self->{'pid'};
  if ($self->auto_save) {
    # save work for the user...
    $self->query('save'); 
    $self->synch;
  }
  $self->query('quit');

  # just for paranoid reasons. shouldn't be necessary
  close $self->{'write'} if $self->{'write'};  
  close $self->{'read'}  if $self->{'read'};
  waitpid($self->{pid},0) if $self->{'pid'};
}

sub encore {
  my $self = shift;
  return $self->status == STATUS_PENDING;
}

sub auto_save {
  my $self = shift;
  $self->{'auto_save'} = $_[0] if defined $_[0];
  return $self->{'auto_save'};
}

sub status {
  return $_[0]->{'status'};
}

sub error {
  my $self = shift;
  return $self->{'error'};
}

sub query {
  my $self = shift;
  my $query = shift;
  warn "query($query)\n" if $self->debug;
  if ($self->debug) {
    my $msg = $query || '';
    warn "\tquery($msg)";
  }