view release on metacpan or  search on metacpan

lib/CWB.pm  view on Meta::CPAN

=item $reg->delete_property($property);

You can also use the B<property()> method to set the value of a property
by passing a second argument. This will add a new corpus property if
I<$property> isn't already defined. Use B<delete_property()> to remove
a corpus property.

=cut

sub list_properties ( $ ) {
  my $self = shift;
  return map {$_->[0]} @{$self->{PROPERTIES}};
}

sub delete_property ( $$ ) {
  my ($self, $p) = @_;
  my $PROP = $self->{PROPERTIES};
  my $N = @$PROP;
  for (my $i = 0; $i < $N; $i++) {
    if ($PROP->[$i]->[0] eq $p) {
      splice(@$PROP, $i, 1);                    # remove this entry
      $self->delete_line_comment("::$p");
      $self->set_comments("::$p");
      last;
    }
  }
}

sub property ( $$;$ ) {
  my ($self, $p, $v) = @_;
  my $PROP = $self->{PROPERTIES};
  my $N = @$PROP;
  my $found = 0;
  my $previous = undef;
  for (my $i = 0; $i < $N; $i++) {
    if ($PROP->[$i]->[0] eq $p) {
      $found = 1;
      $previous = $PROP->[$i]->[1];
      $PROP->[$i]->[1] = $v
        if defined $v;
      last;
    }
  }
  if (defined $v and not $found) {
    push @$PROP, [$p => $v];
  }
  return $previous;
}

=item @attr = $reg->list_attributes;

=item @attr_of_type = $reg->list_attributes($type);

=item $type = $reg->attribute($att_name);

B<list_attributes()> returns the names of all declared attributes. The
B<attribute()> method returns the type of the specified attribute, or an
undefined value if the attribute is not declared. I<$type> is one of
C<'p'> (B<positional>), C<'s'> (B<structural>), or C<'a'> (B<alignment>). 
Passing one of these type codes to B<list_attributes()> will return
attributes of the selected type only. 

=cut

sub list_attributes ( $;$ ) {
  my ($self, $type) = @_;
  my @list = @{$self->{SERIALIZE}};
  if (defined $type) {
    $type = lc $type;
    @list = grep {$self->{ATT}->{$_} eq $type} @list;
  }
  return @list;
}

sub attribute ( $$ ) {
  my ($self, $name) = @_;
  return $self->{ATT}->{$name};
}

=item $reg->add_attribute($att_name, $type);

=item $reg->delete_attribute($att_name);

B<add_attribute()> adds an attribute of type I<$type> (B<p>, B<s>, or
B<a>, see above). The duplicate declaration of an attribute with the
same type is silently ignored. Re-declaration with a different type is
a fatal error. Use B<delete_attribute()> to remove an attribute of the
specified name, regardless of its type.

=cut

sub delete_attribute ( $$ ) {
  my ($self, $name) = @_;
  if (exists $self->{ATT}->{$name}) {
    @{$self->{SERIALIZE}} = grep {$_ ne $name} @{$self->{SERIALIZE}}; # remove attribute from serialization
    $self->delete_line_comment($name);
    $self->set_comments($name);
    return delete $self->{ATT}->{$name};
  }
  else {
    return undef;
  }
}

sub add_attribute( $$$ ) {
  my ($self, $name, $type) = @_;
  die "CWB::RegistryFile: invalid attribute type '$type' for attribute $name\n"
      unless $type =~ /^[PpSsAa]$/;
  $type = lc $type;
  my $previous = $self->{ATT}->{$name};         # check if attribute is already defined
  if (defined $previous) {
    die "CWB::RegistryFile: can't add $type-attribute $name, already declared as $previous-attribute\n"
      unless $previous eq $type;
    # nothing to do if attribute is already defined
  }
  else {
    $self->{ATT}->{$name} = $type;
    push @{$self->{SERIALIZE}}, $name;
  }
}