view release on metacpan or  search on metacpan

lib/CWB/CQP.pm  view on Meta::CPAN

    my $row_el = @$row;
    if (not defined $n_el) {
      $n_el = $row_el;
      croak "CQP: row arrays in undump table must have between 2 and 4 elements (first row has $n_el)"
        if $n_el < 2 or $n_el > 4;
      $with = "with target"
        if $n_el >= 3;
      $with .= " keyword"
        if $n_el >= 4;
    }
    else {
      croak "CQP: all rows in undump table must have the same length (first row = $n_el, this row = $row_el)"
        unless $row_el == $n_el;
    }
    $tf->write(join("\t", @$row), "\n");
  }
  $tf->finish;

  # now send undump command with filename of temporary file
  my $tempfile = $tf->name;
  $self->exec("undump $nqr $with < 'gzip -cd $tempfile |'");

  $tf->close;                                   # delete temporary file

  return $self->ok;                             # return success status of undump command
}

=item I<$status> = I<$cqp>->B<status>;  # "ok" or "error"

=item I<$ok> = I<$cqp>->B<ok>;

=item I<@lines> = I<$cqp>->B<error_message>;

=item I<$cqp>->B<error>(I<@message>);

Error handling functions.  B<status> returns the status of the last CQP command executed, which is either C<'ok'> or C<'error'>.  B<ok> returns B<true> or B<false>, depending on whether the last command was completed successfully (i.e., it is a simpl...

B<error> is an internal function used to report CQP errors.  It may also be of interest to application programs if a suitable error handler has been defined (see below).

=cut

## query CQP object's status and error messages
sub status {
  my $self = shift;

  return $self->{'status'};
}

sub ok {
  my $self = shift;
  return ($self->status eq 'ok'); # convenient wrapper function to check for CQP errors
}

sub error_message {
  my $self = shift;
  my $aref = $self->{'error_message'};

  return @{$aref};
}

## throw CQP error (optionally through user-defined error handler)
sub error {
  my $self = shift;

  if (ref $self->{'error_handler'} eq 'CODE') {
    $self->{'error_handler'}->(@_); # call error handler if a suitable subref has been installed
  }
  else {
    warn "\n", "=+===CWB::CQP ERROR=====\n", # default behaviour is to issue a warning on stderr
      (map {" | $_\n"} @_), "=+======================\n"; 
  }
}

=item I<$cqp>->B<set_error_handler>(I<&my_error_handler>);

=item I<$cqp>->B<set_error_handler>('die' | 'warn' | 'ignore');

The first form of the B<set_error_handler> method activates a user-defined error handler.  The argument is a reference to a named or anonymous subroutine, which will be called whenever a CQP error is detected (or an error is raised explicitly with th...

The second form of the method activates one of the built-in error handlers:

=over 4

=item *

B<C<'die'>> aborts program execution with an error message; this handler is particularly convenient for one-off scripts or command-line utilities that do not need to recover from error conditions.

=item *

B<C<'warn'>> prints the error message on STDERR, but continues program execution.  This is the default error handler of a new B<CWB::CQP> object.

=item *

B<C<'ignore'>> silently ignores all errors.  The application script should check for error conditions after every CQP command, using the B<ok> or B<status> method.

=back 

=cut

## set user-defined error handler (or built-in handlers 'die', 'warn' [default], 'ignore')
sub set_error_handler {
  my $self = shift;
  my $handler = shift;

  if (defined $handler) {
    my $type = ref $handler;
    if ($type ne 'CODE') {
      $handler = lc($handler);
      croak 'USAGE:  $cqp->set_error_handler( \&my_error_handler | "die" | "warn" | "ignore" );'
        unless $handler =~ /^(die|warn|ignore)$/;
      if ($handler eq 'die') {
        $handler = \&_error_handler_die;
      }
      elsif ($handler eq 'warn') {
        $handler = undef;       # default behaviour if no error handler is specified
      }
      elsif ($handler eq 'ignore') {
        $handler = \&_error_handler_ignore;
      }
    }
  }