Alt-CWB-ambs
view release on metacpan or search on metacpan
lib/CWB/Encoder.pm view on Meta::CPAN
package CWB::Encoder;
# -*-cperl-*-
use strict;
use warnings;
=head1 NAME
CWB::Encoder - Perl tools for encoding and indexing CWB corpora
=head1 SYNOPSIS
use CWB::Encoder;
$bnc = new CWB::Indexer "BNC";
$bnc = new CWB::Indexer "/path/to/registry:BNC";
$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>],
NEEDED => [qw<CORPUS LEXICON LEXIDX>],
CREATES => [qw<FREQS>],
COMMAND => "$CWB::Makeall #R -c FREQS -P #A #C",
DELETE => [],
},
LEXSRT => {
TRIGGER => [qw<CORPUS LEXICON LEXIDX>],
NEEDED => [qw<LEXICON LEXIDX>],
CREATES => [qw<LEXSRT>],
COMMAND => "$CWB::Makeall #R -c LEXSRT -P #A #C",
DELETE => [],
},
CIS => {
TRIGGER => [qw<CORPUS LEXICON LEXIDX FREQS>],
NEEDED => [qw<CORPUS LEXICON LEXIDX FREQS>],
CREATES => [qw<CIS CISCODE CISSYNC>],
COMMAND => "$CWB::Huffcode #R #T -P #A #C",
DELETE => [qw<CORPUS>],
},
CISCODE => {
TRIGGER => [qw<CORPUS LEXICON LEXIDX FREQS>],
NEEDED => [qw<CORPUS LEXICON LEXIDX FREQS>],
CREATES => [qw<CIS CISCODE CISSYNC>],
COMMAND => "$CWB::Huffcode #R #T -P #A #C",
DELETE => [qw<CORPUS>],
},
lib/CWB/Encoder.pm view on Meta::CPAN
}
elsif (/Attribute:\s+(\S+)/ or /Attribute\s+(\S+):/) {
$attr = $1;
}
elsif (/Path\/Value:\s+(\S(.*\S)?)/) {
croak "CWB::Indexer: Can't find component name for file $1 (aborted).\n"
unless $comp;
croak "CWB::Indexer: Can't find attribute name for file $1 (aborted).\n"
unless $attr;
$self->{FILES}->{$attr}->{$comp} = $1;
$comp = $attr = ""; # reset to check for syntax errors
}
elsif (/Type:\s+([A-Z])/) {
carp "CWB::Indexer: Missing attribute name in output of cwb-describe-corpus $name (skipped).\n"
unless $attr;
$self->{TYPES}->{$attr} = $1;
}
# all other lines are ignored
}
return bless($self, $class);
}
=item $idx->group($group);
=item $idx->perm($permission);
Optional group membership and access permissions for newly created
files (otherwise, neither B<chgrp> nor B<chmod> will be called). Note
that I<$permission> must be a string rather than an octal number (as
for the built-in B<chmod> function). Indexing will fail if the
specified group and/or permissions cannot be set.
=cut
sub group {
my ($self, $group) = @_;
$self->{GROUP} = $group;
}
sub perm {
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};
lib/CWB/Encoder.pm view on Meta::CPAN
sub null_attributes {
my $self = shift;
push @{$self->{NATT}}, @_;
}
=item $enc->group($group);
=item $enc->perm($permission);
Optional group membership and access permissions for newly created
files (otherwise, neither B<chgrp> nor B<chmod> will be called). Note
that I<$permission> must be a string rather than an octal number (as
for the built-in B<chmod> function). Encoding will fail if the
specified group and/or permissions cannot be set. If the data
directory has to be created, its access permissions and group
membership are set accordingly.
=cut
sub group {
my ($self, $group) = @_;
$self->{GROUP} = $group;
}
sub perm {
my ($self, $perm) = @_;
$self->{PERM} = $perm;
}
=item $enc->overwrite(1);
Allow B<CWB::Encoder> to overwrite existing files. This is required
when either the registry entry or the data directory exists already.
When overwriting is enabled, the registry entry and all files in the
data directory are deleted before encoding starts.
=cut
sub overwrite {
my ($self, $yesno) = @_;
$self->{OVERWRITE} = $yesno;
}
=item $enc->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. The memory setting is only used
when building indices for positional attributes, not during the
initial encoding process.
=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 $enc->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 $enc->decode_entities(0);
Whether B<cwb-encode> is allowed to decode XML entities and skip XML
comments (with the C<-x> option). Set this option to false if you
want an HTML-compatible encoding of the CWB corpus that does not need
to be converted before display in a Web browser.
=cut
sub decode_entities {
my ($self, $yesno) = @_;
$self->{ENTITIES} = $yesno;
}
=item $enc->undef_symbol("__UNDEF__");
Symbol inserted for missing values of positional attributes (either
because there are too few columns in the input or because attribute
values are explicit empty strings). By default, no special symbol
is inserted (i.e. missing values are encoded as empty strings C<"">).
Use the command shown above to mimic the standard behaviour of
B<cwb-encode>.
=cut
sub undef_symbol {
my ($self, $symbol) = @_;
$symbol = "" unless defined $symbol;
croak "CWB::Indexer: symbol <$symbol> for missing values of p-attributes must not contain single quotes or control characters (aborted).\n"
if $symbol =~ /[\x{00}-\x{1f}']/;
$self->{UNDEF_SYMBOL} = $symbol;
}
=item $enc->verbose(1);
Print some progress information (on STDOUT).
=cut
sub verbose {
my ($self, $yesno) = @_;
$self->{VERBOSE} = $yesno;
}
=item $enc->debug(1);
Activate debugging output (on STDERR).
=cut
sub debug {
my ($self, $yesno) = @_;
$self->{DEBUG} = $yesno;
$self->{VERBOSE} = 1 # debugging also activates verbose output
if $yesno;
}
lib/CWB/Encoder.pm view on Meta::CPAN
CWB::Shell::Cmd("chmod $perm $pattern")
if $perm;
CWB::Shell::Cmd("chgrp $group $pattern")
if $group;
}
foreach my $attspec (@{$self->{SATT}}) { # structural attributes
my $temp = $attspec; # don't modify original list
my $rec = ($temp =~ s/:([0-9]+)//) ? $1 : 0; # recursion depth
my ($att, @xmlatts) = split /\+/, $temp; # attribute name and XML tag attributes
foreach my $n ("", 1 .. $rec) { # indices of embedded regions
foreach my $ext ("", map {"_$_"} @xmlatts) { # extensions for XML tag attributes
my $pattern = "'$dir'/$att$ext$n.*";
print STDERR "CWB::Encoder: processing group $pattern\n"
if $self->{DEBUG} and ($perm or $group);
CWB::Shell::Cmd("chmod $perm $pattern")
if $perm;
CWB::Shell::Cmd("chgrp $group $pattern")
if $group;
}
}
}
print "Writing .info file ...\n" # write .info file
if $self->{VERBOSE};
my $infofile = "$dir/.info";
my $fh = CWB::OpenFile "> $infofile";
print $fh $self->{INFO}, "\n";
$fh->close;
CWB::Shell::Cmd("chmod $perm '$infofile'")
if $perm;
CWB::Shell::Cmd("chgrp $group '$infofile'")
if $group;
print "Editing registry entry ...\n" # edit registry file
if $self->{VERBOSE};
my $reg = $self->{REGISTRY};
my $name = $self->{NAME};
my $regfile = "$reg/$name";
my $rf = new CWB::RegistryFile $regfile;
croak "CWB::Encoder: Syntax error in registry entry $regfile\n"
unless defined $rf;
$rf->name($self->{LONGNAME});
# $rf->property("charset", $self->{CHARSET}); # -- already set by cwb-encode (since v2.2.101)
$rf->property("language", $self->{LANG});
$rf->write($regfile);
print STDERR "CWB::Encoder: registry entry $regfile has been edited\n"
if $self->{DEBUG};
print STDERR "CWB::Encoder: setting access permissions for $regfile\n"
if $self->{DEBUG} and ($perm or $group);
CWB::Shell::Cmd("chmod $perm '$regfile'")
if $perm;
CWB::Shell::Cmd("chgrp $group '$regfile'")
if $group;
my $idx = new CWB::Indexer "$reg:".(uc $name); # build indices and compress p-attributes
$idx->group($group)
if $group;
$idx->perm($perm)
if $perm;
$idx->memory($self->{MEMORY});
$idx->validate($self->{VALIDATE});
$idx->debug($self->{DEBUG});
print "Building indices and compressing p-attributes ...\n"
if $self->{VERBOSE};
$idx->makeall;
}
=back
=cut
## ======================================================================
1;
__END__
=head1 COPYRIGHT
Copyright (C) 2002-2010 Stefan Evert [http::/purl.org/stefan.evert]
This software is provided AS IS and the author makes no warranty as to
its use and performance. You may use the software, redistribute and
modify it under the same terms as Perl itself.
=cut
( run in 1.431 second using v1.01-cache-2.11-cpan-437f7b0c052 )