Alt-CWB-ambs
view release on metacpan or search on metacpan
in I<@lines>. If there is a large amount of standard ouput, it is more efficient
to use the second form.
=cut
sub Cmd {
my $cmd = shift;
my $outfile = shift;
defined $outfile or $outfile = "";
# create arrays into which stdout / stderr will be read
# if second argument is arrayref, store stdout in that array, else create private anonymous array
my $stdout = [];
if ((ref $outfile) eq 'ARRAY') {
$stdout = $outfile;
$outfile = ""; # so we'll create a temporary file
}
my $stderr = [];
my $stdout_tmp = undef; # create temporary files for capturing stdout and stderr
my $stderr_tmp = new CWB::TempFile "CWB-Shell-Cmd-STDERR";
my $stdout_file = $outfile;
if (not $outfile) {
$stdout_tmp = new CWB::TempFile "CWB-Shell-Cmd-STDOUT";
$stdout_tmp->finish; # now we're allowed to access the file directly
$stdout_file = $stdout_tmp->name;
}
$stderr_tmp->finish;
my $stderr_file = $stderr_tmp->name;
my $status = system "($cmd) 1>$stdout_file 2>$stderr_file";
my $syscode = $status & 0xff;
my $exitval = $status >> 8;
my $fh = CWB::OpenFile $stderr_file;
@$stderr = <$fh>;
map {chomp;} @$stderr;
$fh->close;
if ($outfile) {
@$stdout = (); # don't check STDOUT if caller wants it in file
}
else {
$fh = CWB::OpenFile $stdout_file;
@$stdout = <$fh>;
map {chomp;} @$stdout;
$fh->close;
}
$current_cmd = $cmd; # Error() may want to report the command that failed
$return_status = 0; # error level will be increased (but not decreased) by Error() function
Error 6, "System error: $!", @$stderr
if $syscode != 0;
Error 5, "Non-zero exit value $exitval.", @$stderr
if $exitval != 0;
Error 5, "Error message on stderr:", @$stderr
if grep { /error|fail|abnormal|abort/i } @$stderr;
Error 3, "Warning on stderr:", @$stderr
if grep { /warn|problem/i } @$stderr;
Error 2, "Stderr output:", @$stderr
if @$stderr;
Error 1, "Error message on stdout:", @$stdout
if grep { /error|fail|abnormal|abort/i } @$stdout;
# return highest error status set by one of the previous commands
return $return_status;
}
=back
=cut
lib/CWB/CQP.pm view on Meta::CPAN
sub new {
my $class = shift; # class name
my $self = {}; # namespace for new CQP class object
my @options = @_; # CQP command-line options (use at your own risk)
# split options with values, e.g. "-r /my/registry" => "-r", "/my/registry" (doesn't work for multiple options in one string)
@options = map { (/^(--?[A-Za-z0-9]+)\s+(.+)$/) ? ($1, $2) : $_ } @options;
## run CQP server in the background
my $in = $self->{'in'} = new FileHandle; # stdin of CQP
my $out = $self->{'out'} = new FileHandle; # stdout of CQP
my $err = $self->{'err'} = new FileHandle; # stderr of CQP
my $pid = open3($in, $out, $err, $CWB::CQP, @CQP_options, @options);
$self->{'pid'} = $pid; # child process ID (so process can be killed if necessary)
$in->autoflush(1); # make sure that commands sent to CQP are always flushed immediately
my ($need_major, $need_minor, $need_beta) = split /\./, $CQP_version; # required CQP version
$need_beta = 0 unless $need_beta;
my $version_string = $out->getline; # child mode (-c) should print version on startup
chomp $version_string;
croak "ERROR: CQP backend startup failed ('$CWB::CQP @CQP_options @options')\n"
lib/CWB/CQP.pm view on Meta::CPAN
and ($2 > $need_minor or
($2 == $need_minor and $3 >= $need_beta)));
## command execution
$self->{'command'} = undef; # CQP command string that is currently being processed (undef = last command has been completed)
$self->{'lines'} = []; # array of output lines read from CQP process
$self->{'buffer'} = ""; # read buffer for standard output from CQP process
$self->{'block_size'} = 256; # block size for reading from CQP's output and error streams
$self->{'query_lock'} = undef;# holds random key while query lock mode is active
## error handling (messages on stderr)
$self->{'error_handler'} = undef; # set to subref for user-defined error handler
$self->{'status'} = 'ok'; # status of last executed command ('ok' or 'error')
$self->{'error_message'} = []; # arrayref to array containing message produced by last command (if any)
## handling of CQP progress messages
$self->{'progress'} = 0; # whether progress messages are activated
$self->{'progress_handler'} = undef; # optional callback for progress messages
$self->{'progress_info'} = []; # contains last available progress information: [$total_percent, $pass, $n_passes, $message, $percent]
## debugging (prints more or less everything on stdout)
$self->{'debug'} = 0;
## select vectors for CQP output (stdout, stderr, stdout|stderr)
$self->{'select_err'} = new IO::Select($err);
$self->{'select_out'} = new IO::Select($out);
$self->{'select_any'} = new IO::Select($err, $out);
## CQP object setup complete
bless($self, $class);
## the following command will collect and ignore any output which may have been produced during startup
$self->exec("set PrettyPrint off"); # pretty-printing should be turned off for non-interactive use
lib/CWB/CQP.pm view on Meta::CPAN
my $version = $self->{'major_version'}.".".$self->{'minor_version'};
my $beta = $self->{'beta_version'};
$version .= ".$beta"
if $beta > 0;
return $version;
}
## INTERNAL:
## $lines_read = $self->_update([$timeout]);
## This is the main "workhorse" of the CWB::CQP module. It checks for output from CQP process
## (stdout and stderr), updates progress status, fills internal buffers, and calls error and
## progress handlers if necessary. The optional $timeout specifies how many seconds to wait for
## output; the default is 0 seconds, i.e. non-blocking mode, while a negative value blocks.
## NB: $lines_read includes the .EOL. terminator line, so it is safe to keep calling _update()
## until a non-zero value is returned (even if a CQP command fails with an error message).
sub _update {
my $self = shift;
my $timeout = shift || 0;
$timeout = undef
if $timeout < 0;
my $stderr_buffer = "";
my $lines = 0; # how many lines have successfully been read from stdout
while ($self->{'select_any'}->can_read($timeout)) {
## STDERR -- read all available output on stderr first
if ($self->{'select_err'}->can_read(0)) {
sysread $self->{'err'}, $stderr_buffer, $self->{'block_size'}, length($stderr_buffer); # append to $stderr_buffer
}
## STDOUT -- if there is no more data on stderr, we should be able to read from stdout
elsif ($self->{'select_out'}->can_read(0)) {
sysread $self->{'out'}, $self->{'buffer'}, $self->{'block_size'}, length($self->{'buffer'}); # append to object's input buffer
if ($self->{'buffer'} =~ /\n/) {
## if there's a complete line in the input buffer, split off all lines
my @new_lines = split /\n/, $self->{'buffer'}, -1; # make sure that last line is handled correctly if buffer ends in \n
$self->{'buffer'} = pop @new_lines; # last entry is incomplete line ("" if buffer ended in \n) => return to input buffer
foreach my $line (@new_lines) {
## skip blank line printed after each CQP command
next if $line eq "";
## handle progress messages if ProgressBar has been activated
lib/CWB/CQP.pm view on Meta::CPAN
$handler->($total_percent, $pass, $n_passes, $message, $percent); # call user-defined progress handler
}
}
## regular output lines are collected in object's line buffer
else {
push @{$self->{'lines'}}, $line;
$lines++;
}
}
}
last if $lines > 0; # if we have read a line and there is no output on stderr, return from function
}
## ERROR -- we should never reach this point
else {
die "CWB::CQP: INTERNAL ERROR in _update() -- no data on stdout or stderr of CQP child process";
}
}
if ($stderr_buffer ne "") {
$self->{'status'} = 'error'; # any output on stderr indicates that something went wrong
push @{$self->{'error_message'}}, split /\n/, $stderr_buffer; # append output on stderr to error message
$self->error(@{$self->{'error_message'}}); # may call error handler and abort, or print message and continue
}
return $lines;
}
=item I<$cqp>->B<run>(I<$cmd>);
Start a single CQP command I<$cmd> in the background. This method returns immediately.
Command output can then be read with the B<getline>, B<getlines> and B<getrow> methods.
If asynchronous communication is desired, use B<ready> to check whether output is available.
lib/CWB/CQP.pm view on Meta::CPAN
}
## 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...
script/cwb-regedit view on Meta::CPAN
Display corpus header information (corpus ID, corpus name, data directory, info file).
=item (B<:id> | B<:name> | B<:home> | B<:ifile>) I<value>
Modify corpus header information (corpus ID, corpus name, data directory, info file).
Don't forget to quote I<value> with single or double quotes if it contains whitespace or other special characters.
=item B<:prop> I<name>
Display corpus property I<name>. If this property is not defined, B<cwb-regedit> prints an
empty line and issues a warning message on B<stderr>.
=item B<:prop> I<name> I<value>
Modify or add corpus property I<name>. Don't forget to quote I<value> if it contains whitespace or special characters.
=item B<:list> (B<:p> | B<:s> | B<:a>) ...
List all attributes of the specified type: B<:p> for positional attributes, B<:s> for structural attributes,
and B<:a> for alignment attributes. Attribute names are printed on a single line separated by blanks.
You can specify multiple attribute types without repeating the B<:list> keyword, e.g. C<:list :p :s>.
( run in 1.268 second using v1.01-cache-2.11-cpan-49f99fa48dc )