view release on metacpan or  search on metacpan

lib/CWB.pm  view on Meta::CPAN

=item $reg->delete_line_comment($key);

Inline comments use the same I<$key> identifiers as comment lines.
Just as with the INFO field, the B<line_comment()> method allows you
to get and set inline comments, and B<delete_line_comment()> removes
an inline comment. 

=cut

sub line_comment ( $$;$ ) {
  my ($self, $key, $newval) = @_;
  $self->check_key($key);
  my $val = $self->{LINECOMMENT}->{$key};
  $self->{LINECOMMENT}->{$key} = $newval
    if defined $newval;
  return (defined $val) ? $val : "";
}

sub delete_line_comment ( $$ ) {
  my ($self, $key) = @_;
  $self->check_key($key);
  return delete $self->{LINECOMMENT}->{$key};
}

# internal function: helper methods for writing comments to disk file
sub write_comments ( $$$ ) {                    # $self->write_comments($fh, $key);
  my ($self, $fh, $key) = @_;
  my $comm = $self->{COMMENTS}->{$key};
  if (defined $comm) {
    foreach my $line (@$comm) {
      if ($line eq "") {
        print $fh "\n";                         # blank line
      }
      else {
        my $comm = $line;                       # make a copy so we don't modify original data
        $comm = " ".$comm
          unless $comm =~ /^(\#|\s)/;
        print $fh "#$comm\n";                   # begin line with comment marker '#'
      }
    }
  }
}

# internal function: helper method for writing inline comments to disk file
sub write_line_comment ( $$$ ) {                # $self->write_line_comment($fh, $key);   always writes newline
  my ($self, $fh, $key) = @_;
  my $comm = $self->{LINECOMMENT}->{$key};
  if (defined $comm) {
    $comm = " ".$comm
      unless $comm =~ /^(\#|\s)/;
    print $fh "\t#$comm";
  }
  print $fh "\n";
}

# helper function: write HOME or INFO path as double-quoted string if it is not a simple ID
sub _quote_path ( $ ) {
  my $path = shift;
  if ($path !~ /^[A-Za-z0-9_\-\/][A-Za-z0-9_\.\-\/]+$/) {
    $path =~ s/"/\\"/g; # escape all literal double quotes
    $path = "\"$path\"";
  }
  return $path;
}

=item $reg->write($filename);

Write registry file to disk in canonical format. I<$filename> has to be a full
absolute or relative path.  For safety reasons, the B<write()> method does
I<not> automatically save a file in the default registry directory.  Make sure
that the filename is all lowercase and identical to the corpus ID, or the CWB
tools and CQP will not be able to read the registry file.

If I<$reg> was initialised from a registry file, I<$filename> can be omitted.
In this case, the original file will automatically be overwritten.

=cut

sub write ( $;$ ) {
  my ($self, $filename) = @_;
  $filename = $self->filename
    unless defined $filename;
  die "CWB::RegistryFile: filename not specified for write() method\n"
    unless defined $filename;
  # check that required fields are defined before creating file
  die "CWB::RegistryFile: can't write $filename -- ID not set\n"
    unless defined $self->id;
  die "CWB::RegistryFile: can't write $filename -- HOME not set\n"
    unless defined $self->home;
  my $fh = CWB::OpenFile "> $filename";
  # write standard fields: NAME, ID, HOME [, INFO]
  $self->write_comments($fh, ":NAME");
  print $fh "NAME \"",$self->name,"\"";
  $self->write_line_comment($fh, ":NAME");
  $self->write_comments($fh, ":ID");
  print $fh "ID   ",$self->id;
  $self->write_line_comment($fh, ":ID");
  $self->write_comments($fh, ":HOME");
  print $fh "HOME ",_quote_path($self->home);
  $self->write_line_comment($fh, ":HOME");
  if (defined $self->info) {
    $self->write_comments($fh, ":INFO");
    print $fh "INFO ",_quote_path($self->info);
    $self->write_line_comment($fh, ":INFO");
  }
  # write corpus properties
  foreach my $pair (@{$self->{PROPERTIES}}) {
    my ($p, $v) = @$pair;
    $self->write_comments($fh, "::$p");
    print $fh "##:: $p = \"$v\"";
    $self->write_line_comment($fh, "::$p");
  }
  print $fh "#", "=" x 72, "#\n"; # header separator bar -- must be ignored when reading in
  # write attributes (in the order given in SERIALIZE) 
  foreach my $att (@{$self->{SERIALIZE}}) {
    $self->write_comments($fh, $att);
    my $type = $self->attribute($att);
    print $fh type2keyword($type), " $att";
    $self->write_line_comment($fh, $att);
  }