view release on metacpan or  search on metacpan

lib/Biblio/Thesaurus.pm  view on Meta::CPAN

      $self->{inverses}{uc($1)} = uc($2);
      $self->{inverses}{uc($2)} = uc($1);

    } elsif (/^%\s*enc(oding)?\s+(\S+)/) {

      $self->{encoding} = lc $2;
      $self->{encoding} =~ s/_/-/g;
      binmode ISO, ":encoding($self->{encoding})";

    } elsif (/^%\s*tit(le)?\s+(.+)/) {
      $self->{title} = $2;

    } elsif (/^%\s*aut(hor)?\s+(.+)/) {
      $self->{author} = $2;

    } elsif (/^%\s*desc(ription)?\[(\S+)\]\s+(\S+)\s+(.*)$/) {

      # Treat the desc*cription [lang] command....  'RT EN'
      $self->{descriptions}{uc($3)." ".uc($2)} = $3;

    } elsif (/^%\s*desc(ription)?\s+(\S+)\s+(.*)$/) {

      # Treat the desc*cription command
      $self->{descriptions}{uc($2)} = $3;

    } elsif (/^%\s*ext(ernals?)?\s+(.*)$/) {

      # Treat the ext*ernals command
      chomp(my $classes = uc($2));
      for (split /\s+/, $classes) {
				$self->{externals}{$_} = 1;
      }

    } elsif (/^%\s*lang(uages?)?\s+(.*)$/) {

      # Treat the lang*uages command
      chomp(my $classes = uc($2));
      for (split /\s+/, $classes) {
				$self->{languages}{$_} = 1;
      }

    } elsif (/^%\s*top\s+(.*)$/) {

      $self->{name} = $1;

    } elsif (/^%\s*baselang(uage)?\s+(\S+)/) {

      $self->{baselang} = uc($2);

    } elsif (/^%/) {

      print STDERR "Unknown command: '$_'\n\n";

    } else {
      # It's a comment or an empty line: do nothing
    }
  }

  # Redefine the record separator
  my $old_sep = $/;
  $/ = "";

  # The last line wasn't a comment, a command or an empty line, so use it!
  $_ .= <ISO>;

  my $ncommands = $.-1;

  # While there are definitions...
  do {
    # define local variables
    my ($class,$term,$relations);

    ## Concat lines that continue back in one
    s/\n[ \t]+/ /g;  # Can't use \s because "\n" =~ m!\s!

    # The first line contains the term to be defined
    /(.+)(?:\n((.|\n)+)|\n?$)/;
    $term = $1;
    $relations = $2 || "";

    # If the term is all spaces, go back...
    if ($term =~ /^\s+$/) {
      print STDERR "Term with only spaces ignored at block term ",$.-$ncommands,"\n\n";
      $term = '#zbr'; # This makes the next loop think this is a comment and ignore it
    }

    # Let's see if the term is commented...
    unless ($term =~ /^#/) {
      $term = _term_normalize($term);

      $term = $self->{defined}{lc($term)} if ($self->{defined}{lc($term)});
      $thesaurus{$term}{_NAME_} = $term;
      $self->{defined}{lc($term)} = $term;

      # The remaining are relations
      $_ = $relations;

      # OK! The term is *not* commented...
      # For each definition line...
      $_.="\n" unless /\n$/;
      while (/((([^#\s]+)|#)[ \t]*(.*)\n)/g) {
		next unless $4;
		# Is it commented?
		unless ($2 eq "#") {
	  		# it seems not... set the relation class
	  		$class = uc($2); # || $class;... now multiline are handled before this

          print STDERR "** WARNING **: '$1'\n" unless $class;

	  # See if $class has a description
	  $self->{descriptions}{$class} = ucfirst(lc($class)) unless defined $self->{descriptions}{$class};
	  ## $descs->{$class}= ucfirst(lc($class))  unless(defined($descs->{$class}));

	  # divide the relation terms by comma unless it is a language or extern relation
	  if ( exists($self->{externals}{$class}) && defined($self->{externals}{$class}) ) {
	    ## $thesaurus{$term}{$class}.= ($2?"$4":" $4");
	    ## $thesaurus{$term}{$class}.= ($thesaurus{$term}{$class}?" $4":"$4");
            push @{$thesaurus{$term}{$class}}, $4;
	  } elsif (exists($self->{languages}{$class}) && defined($self->{languages}{$class})) {
	    # $translations->{$class}->{_term_normalize($4)}.=$term;
	    $self->{$class}{$4}.=$term;