view release on metacpan or  search on metacpan

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

  $bnc->group("corpora");     # optional: group and access
  $bnc->perm("640");          # permissions for newly created files

  $bnc->memory(400);          # use up to 400 MB of RAM (default: 75)
  $bnc->validate(0);          # disable validation for faster indexing
  $bnc->debug(1);             # enable debugging output

  $bnc->make("word", "pos");  # build index & compress
  $bnc->makeall;              # process all p-attributes


  $bnc = new CWB::Encoder "BNC";

  $bnc->registry("/path/to/registry");  # will try to guess otherwise
  $bnc->dir("/path/to/data/directory"); # directory for corpus data files
  $bnc->overwrite(1);         # may overwrite existing files / directories
  
  $bnc->longname("British National Corpus"); # optional
  $bnc->info("Line1.\nLine2.\n...");    # optional multi-line info text
  $bnc->charset("latin1");    # defaults to latin1
  $bnc->language("en");       # defaults to ??
  
  $bnc->group("corpora");     # optional: group and access permissions
  $bnc->perm("640");          # for newly created files & directories

  $bnc->p_attributes("word"); # declare postional atts (no default!)
  $bnc->p_attributes(qw<pos lemma>);  # may be called repeatedly
  $bnc->null_attributes("teiHeader"); # declare null atts (ignored)
  $bnc->s_attributes("s");    # s-attributes in cwb-encode syntax
  $bnc->s_attributes(qw<div0* div1*>);# * = store annotations (-V)
  $bnc->s_attributes("bncDoc:0+id");  # recursion & XML attributes

  $bnc->decode_entities(0);        # don't decode XML entities (with -x flag)
  $bnc->undef_symbol("__UNDEF__"); # mark missing values like cwb-encode

  $bnc->memory(400);          # use up to 400 MB of RAM (default: 75)
  $bnc->validate(0);          # disable validation for faster indexing
  $bnc->verbose(1);           # print some progress information
  $bnc->debug(1);             # enable debugging output

  $bnc->encode(@files);       # encoding, indexing, and compression

  $pipe = $bnc->encode_pipe;  # can also feed input text from Perl script
  while (...) {
    print $pipe "$line\n";
  }
  $bnc->close_pipe;

=head1 DESCRIPTION

This package contains modules for the automatic encoding and indexing
of CWB corpora. 

B<CWB::Indexer> builds indices for some or all positional attributes
of an existing corpus (using the B<cwb-makeall> tool). In addition,
these attributes are automatically compressed (using the
B<cwb-huffcode> and B<cwb-compress-rdx> tools). Compression and
indexing is interleaved to minimise the required amount of temporary
disk space, and a B<make>-like system ensures that old index files are
automatically updated.

B<CWB::Encoder> automates all steps necessary to encode a CWB corpus
(which includes cleaning up old files, running B<cwb-encode>, editing
the registry entry, indexing & compressing positional attributes, and
setting access permissions). Both modules can be set up with a few
simple method calls. Full descriptions are given separately in the
following sections. 

=cut

## ======================================================================
##  automatic creation, compression and updating of CWB index files (for p-attributes)
## ======================================================================

package CWB::Indexer;

use CWB;
use Carp;

# makefile-like rules for creating / updating components
#   TRIGGER .. update component when one of these comps exists & is newer
#   NEEDED  .. componentes required by command below
#   CREATES .. these files will be created by COMMAND
#   COMMAND .. shell command to create this component 
#              interpolates '#C' (corpus id), '#A' (attribute name), '#R' (registry flag), 
#                           '#M' (memory limit), '#T' (no validate), '#V' (validate)
#              (issues "can't create" error message if COMMAND starts with "ERROR")
#   DELETE  .. delete these components when target exist or has been created
our %RULES =
  (
   DIR => {
           TRIGGER => [],
           NEEDED  => [],
           CREATES => [],
           COMMAND => "ERROR: Corpus data directory must be created manually.",
           DELETE  => [],
          },
   CORPUS => {
           TRIGGER => [],
           NEEDED  => [],
           CREATES => [],
           COMMAND => "ERROR: You must run the cwb-encode tool first.",
           DELETE  => [],
          },
   LEXICON => {
           TRIGGER => [],
           NEEDED  => [],
           CREATES => [],
           COMMAND => "ERROR: You must run the cwb-encode tool first.",
           DELETE  => [],
          },
   LEXIDX => {
           TRIGGER => [],
           NEEDED  => [],
           CREATES => [],
           COMMAND => "ERROR: You must run the cwb-encode tool first.",
           DELETE  => [],
          },
   FREQS => {
           TRIGGER => [qw<CORPUS LEXICON LEXIDX>],

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

  my ($self, $perm) = @_;
  $self->{PERM} = $perm;
}

=item $idx->memory($mbytes);

Set approximate memory limit for B<cwb-makeall> command, in MBytes.
The memory limit defaults to 75 MB, which is a reasonable value for
systems with at least 128 MB of RAM. 

=cut

sub memory {
  my ($self, $mem) = @_;
  croak "CWB::Indexer:  memory limit ($mem) must be positive integer number (aborted).\n"
    unless $mem =~ /^[1-9][0-9]*$/;
  $self->{MEMORY} = $mem;
}

=item $idx->validate(0);

Turn off validation of index and compressed files, which may give 
substantial speed improvements for larger corpora.

=cut

sub validate {
  my ($self, $yesno) = @_;
  $self->{VALIDATE} = $yesno;
}

=item $idx->debug(1);

Activate debugging output (on STDERR). 

=cut

sub debug {
  my ($self, $yesno) = @_;
  $self->{DEBUG} = $yesno;
}

# internal method: get full pathname of a component file
sub filename {
  my ($self, $att, $comp) = @_;
  my $path = $self->{FILES}->{$att}->{$comp};
  croak "CWB::Indexer: can't determine filename for component $att/$comp (aborted).\n"
    unless defined $path;
  return $path;
}

# internal method: make single component (recursively builds dependencies)
sub make_comp {
  my ($self, $att, $comp) = @_;
  my $rule = $RULES{$comp};
  croak "CWB::Indexer:  no rule found for component $comp (aborted).\n"
    unless defined $rule;
  my ($trigger, $needed, $creates, $command, $delete) =
    @$rule{qw<TRIGGER NEEDED CREATES COMMAND DELETE>};

  my $update = 0;               # check whether component needs to be created / updated
  my $file = $self->filename($att, $comp);
  if (not -f $file) {
    print STDERR "CWB::Indexer: component $att/$comp does not exist -> create\n"
      if $self->{DEBUG};
    $update = 1;                # file does not exist -> create
  }
  else {
    my $age = -M $file;
    foreach my $t (@$trigger) { # check for triggers that are newer than target
      my $t_file = $self->filename($att, $t);
      if (-f $t_file) {
        my $t_age = -M $t_file;
        if ($t_age < $age) {
          $update = 1;          # trigger is newer -> update
          print STDERR "CWB::Indexer: component $att/$t is newer than $att/$comp -> update\n"
            if $self->{DEBUG};
        }
      }
    }
  }

  if ($update) {                # (re-)create component if necessary
    print STDERR
      "CWB::Indexer: make_comp($att, $comp)\n",
      "CWB::Indexer:   creating component file $file\n"
        if $self->{DEBUG};

    foreach my $c (@$creates) { # delete old target files (first, to make room for intermediate files)
      my $f = $self->filename($att, $c);
      if (-f $f) {
        unlink $f;
        croak "CWB::Indexer: Can't delete file $f (aborted).\n"
          if -e $f;
        print STDERR "CWB::Indexer:   deleting file $f\n"
          if $self->{DEBUG};
      }
    }

    foreach my $c (@$needed) {  # recursively create/update prerequisites
      $self->make_comp($att, $c);
    }

    if ($command =~ s/^\s*ERROR\s*(:\s*)?//) {
      croak
        "CWB::Indexer: Can't create component $att/$comp ($file)\n",
        "              $command\n";
    }

    $command =~ s/\#C/$self->{NAME}/g; # substitute variables in $command
    $command =~ s/\#A/$att/g;
    $command =~ s/\#R/$self->{REGISTRY}/g;
    $command =~ s/\#M/-M $self->{MEMORY}/g;
    $command =~ s/\#T/($self->{VALIDATE}) ? "" : "-T"/eg;
    $command =~ s/\#V/($self->{VALIDATE}) ? "-V" : ""/eg;
    
    print STDERR "CWB::Indexer:   exec: $command\n"
      if $self->{DEBUG};
    CWB::Shell::Cmd $command;   # execute creation command

    my $perm = $self->{PERM};   # check that target file(s) exist and set permissions
    my $group = $self->{GROUP};
    foreach my $c (@$creates) { 
      my $f = $self->filename($att, $c);
      croak "CWB::Indexer: Creation of component $att/$c ($f) failed (aborted).\n"
        unless -s $f;
      if ($perm) {
        my $cmd = "chmod $perm '$f'";
        print STDERR "CWB::Indexer:   exec: $cmd\n"
          if $self->{DEBUG};
        CWB::Shell::Cmd $cmd;
      } 
      if ($group) {
        my $cmd = "chgrp $group '$f'";
        print STDERR "CWB::Indexer:   exec: $cmd\n"
          if $self->{DEBUG};
        CWB::Shell::Cmd $cmd;
      } 
    }

    print STDERR "CWB::Indexer: component $att/$comp has been created successfully\n"
      if $self->{DEBUG};
  }

  # always run the cleanup so that unneccessary files are automatically deleted
  foreach my $c (@$delete) {    # delete intermediate components that are no longer needed
    my $f = $self->filename($att, $c);
    if (-f $f) {
      print STDERR "CWB::Indexer:   deleting file $f\n"
        if $self->{DEBUG};
      unlink $f;
      croak "CWB::Indexer: Can't delete intermediate file $f (aborted).\n"
        if -f $f;
    }
  }
}

=item $idx->make($att1, $att2, ...);

Process one or more positional attributes. An index is built for each
attribute and the data files are compressed. Missing files are
re-created (if possible) and old files are updated automatically.

=cut

sub make {
  my $self = shift;
  my $corpus = $self->{NAME};
  foreach my $att (@_) {
    my $type = $self->{TYPES}->{$att};
    croak "CWB::Indexer:  $corpus.$att is not a positional attribute (aborted).\n"
      unless $type and $type eq "P";
    print STDERR "CWB::Indexer: make($corpus.$att)\n"
      if $self->{DEBUG};
    foreach my $comp (@NEEDED) {
      $self->make_comp($att, $comp);
    }
    print STDERR "CWB::Indexer: attribute $corpus.$att was indexed successfully\n"
      if $self->{DEBUG};
  }
}

=item $idx->makeall;

Process all positional attributes of the corpus.

=cut

sub makeall {
  my $self = shift;
  foreach my $att (keys %{$self->{TYPES}}) {
    $self->make($att)
      if $self->{TYPES}->{$att} eq "P";
  }
}

=back

=cut

## ======================================================================
##  automatic encoding, indexing, and compression of corpora
## ======================================================================

package CWB::Encoder;

use CWB;
use Carp;
use DirHandle;

=head1 CWB::Encoder METHODS

=over 4

=item $enc = new CWB::Encoder $corpus;

Create a new B<CWB::Encoder> object for the specified corpus. Note
that the registry directory cannot be passed directly to the
constructor (use the B<registry> method instead).

=cut