view release on metacpan or  search on metacpan

lib/CWB.pm  view on Meta::CPAN

  if ($errlevel >= $return_status) {  
    $return_status = $errlevel;

    if ($Paranoid < 0) {
      $action = [qw<2 2 2 2 1 1 0>]->[$errlevel];
    }
    elsif ($Paranoid == 0) {
      $action = [qw<2 2 2 1 1 0 0>]->[$errlevel];
    }
    else {
      $action = [qw<2 1 0 0 0 0 0>]->[$errlevel];
    }
  }
  else {
    $action = 2;                # don't report this error if a more serious one has already occurred
  }

  if ($action == 0) {
    croak
      "\nSHELL CMD '$current_cmd' FAILED:\n",
      map {chomp; ">> $_\n"} @message;
  }
  elsif ($action == 1) {
    print "\nWARNING (SHELL CMD '$current_cmd'):\n";
    map {chomp; print "-> $_\n"} @message;
  }
  else {
    # nothing :o)
  }
}


=item $errlvl = CWB::Shell::Cmd($cmd);

=item $errlvl = CWB::Shell::Cmd($cmd, $filename);

=item $errlvl = CWB::Shell::Cmd($cmd, \@lines);

The first form executes I<$cmd> as a shell command (through the built-in
B<system> function) and returns an error level value. With the default
setting of I<$CWB::Shell::Paranoid>, serious errors are usually detected and
cause the script to B<die>, so it is not necessary to check I<$errlvl>. 

The second form stores the standard output of the shell command in
file I<$filename>. It can then be processed with external programs or
read in by the Perl script. B<NB:> Compressed files are not supported!
It is recommended to use an uncompressed temporary file (B<CWB::TempFile> object).

The third form requires an array reference as its second argument. It splits
the standard output of the shell command into B<chomp>ed lines and stores them
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

## ======================================================================
##  parse, modify and create registry entries (in canonical format)
## ======================================================================

package CWB::RegistryFile;

use Carp;

=head1 REGISTRY FILE EDITING

Registry files in B<canonical format> can be loaded into B<CWB::RegistryFile> objects,
edited using the various access methods detailed below, and written back to disk. It
is also possible to create a registry entry from scratch and save it to a disk file.

Canonical registry files consist of a B<header> and a B<body>. The
B<header> begins with a NAME, ID, PATH, and optional INFO field

  NAME "long descriptive name"
  ID   my-corpus
  PATH /path/to/data/directory
  INFO /path/to/info/file.txt

followed by optional B<corpus property> definitions

  ##:: property1 = "value1"
  ##:: property2 = "value2"

The B<body> declares B<positional>, B<structural>, and B<alignment> attributes in
arbitrary order, using the following keywords

  ATTRIBUTE  word     # positional attribute
  STRUCTURE  np       # structural attribute
  ALIGNED    corpus2  # alignment attribute (CORPUS2 is target corpus)

Each attribute declaration may be followed by an alternative directory path on
the same line, if the attribute data is not stored in the HOME directory of the
corpus:

  ATTRIBUTE  lemma  /path/to/other/data/directory

The header fields, corpus properties, and attribute declarations are jointly
referred to as B<content lines>. Each content line may be preceded by an arbitrary
number of B<comment lines> (starting with a C<#> character) and B<blank lines>.
Trailing comments and blank lines (i.e. after the last content line in a registry
file) are allowed but will be ignored by B<CWB::RegistryFile>. Besides, each 
content line may include an B<in-line comment> which extends from the first C<#>
character to the end of the line (see examples above). Note that lines starting
with the special symbol C<##::> are interpreted as corpus property definitions
rather than comments.