#! /usr/bin/perl
###############      Lemma.pm   ###################################
#                                                                 #
# Project Acronym:     PaGAL                                      #
# Document ID:                                                    #
# Date:                16/05/01                                   #
# Author:              Jutta Jäger                                #
# WP/Task              T                                          #
# Abstract:                                                       #
# Distribution:        public                                     #
###################################################################
# Version       Date      Author         Notes                    #
# 01            16/05/01  J                                       #
# 02            01/07/01  J              Mehrwortlemma erkennen   #
# 03            17/11/01  J              auch Leerzeichen am Ende #
# 04            02/12/01  J,G            behandelt auch "Nester"  #
# 05            04/12/01  J              Ein-Buchstaben-Lemma aus-#
#                                        schliessen               #
###################################################################
          

package Lemma;

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw(bereinigen lemma_abkuerzen analysieren);

########################################################################
#                      BEREINIGEN                                      #
#                                                                      #
#   Bekommt einen String übergeben und entfernt in mehreren            #
#   Pattern-Matching-Aktionen alle SGML-Tags sowie Silbentrennungs-    #
#   zeichen und Satzzeichen sowie Leerzeichen am Ende. Bei Nestern     #
#   (mehrere Einträge zu einem Stichwort) enthält das Lemma auch eine  #
#   Zahl, auch dies, und alles was dann noch folgt (Vornamen etc.) wird#
#   gelöscht. Gibt einen "gereinigten" String zurück.                  #
#                                                                      #
########################################################################

sub bereinigen {
  
  my ($lemma)= @_; #wird auch für $langform benutzt
  
  
  #sämtliche sgml-tags innerhalb des Lemmas werden geloescht   
  
  $lemma =~ s/<.+?>//g;
  
  
  #Silbentrennungszeichen loeschen
  
  $lemma =~ s/\|//g;
  
  #Komma, Punkt und evtl. Spaces am Ende loeschen
  
  $lemma =~ s/,?\.? *$//;
  
  #Nest-Eintrag? wenn ja, zweiten Teil loeschen
  
  $lemma =~ s/,? \d\).*$//;
  
  return $lemma;
  
  
}


####################################################################
#                                                                  #
#                         ANALYSIEREN                              #
#                                                                  #
#  Bekommt das Lemma String, zerlegt wortweise in Array. Trenn-    #
#  zeichen sind Leerzeichen und Bindestriche. Gibt als ersten Wert #
#  eine 1 bei Bindestrichen zurück, andernfalls eine 0, sodann     #
#  das Array.                                                      #
#                                                                  #
####################################################################


sub analysieren {

  my ($lemma)= @_;
  
  my ($bindestr) = 0;
  if ($lemma =~ /-/)
    {
      $bindestr =1;
    }
  
  $worttrenner = "-| |&spvgev;|&spfest;"; #  Bindestrich oder Leerzeichen oder geschuetzte Leerzeichen
  
  
  my (@lemma_w) = split (/$worttrenner/, $lemma);
  
  
  return ($bindestr, @lemma_w);
  
  
  
  
}

#########################################################################
#                                                                       #
#                    LEMMA_ABKUERZEN                                    #
#                                                                       #
#   Lemma_abkuerzen ist die Kernfunktion des Moduls. Sie bekommt das    #
#   Lemma und die Langform übergeben, vergleicht diese miteinander      #
#   und generiert bei Übereinstimmung die Abkürzung. Es gibt ein Array  #
#   zurück, das vier Strings enthält: 1)die generierte Abkürzung oder   #
#   eine 0 bei Nicht-Übereinstimmung, 2) was vor dem gematchten Teil    #
#   stand, 3)das Lemma (lang) und was hinter dem gematchten Teil übrig  #
#   blieb.                                                              #
#                                                                       #
#########################################################################


sub lemma_abkuerzen {
  
  my($lemma, $langform) = @_;
  my ($vorne, $hinten) = 0;
  my (@ak_array, $ak_lemma) = 0;
  my ($binder, @lem_array) = &analysieren ($lemma);
  
  if($lemma =~ /^(.|\&[^&;]+;)$/)  #Lemma nur ein Buchstabe(oder eben ein
    # SGML-kodiertes einzelnes Zeichen)
    # -> Ende
    {
      @ret=$ak_lemma, $vorne,$lemma, $hinten;
      
      
      
    }elsif($langform =~/(.*)$lemma(.*)/i) #tritt Lemma-Abkuerzung ein?
      {
	$vorne = $1;
	$hinten = $2;
	
	if ($vorne =~/[a-z]$/){ # wenn vorne etwas steht
	  
	  $vorne = $vorne."-"; # muss vor den abgekuerzten Teil 
	  #ein Bindestrich
	}
	
	
	for ($i=0; $i<@lem_array; $i++)
	  {
	    
	    $lem_array[$i] =~ /^([a-zA-Z&])/; #erstes Zeichen des Lemmas ermitteln
	    $ak_array[$i] = $1;
	    
	    if ("$ak_array[$i]" eq "&") #Sonderfall: 1. zeichen ist ein kodiertes Zeichen
	      {
		$lem_array[$i] =~ /^(&.+;)/;
		$ak_array[$i] = $1;
		
	      }
	    
	    
	    $ak_array[$i] .= "."; #Punkt dahinter
	  }
	
	
	
	if ($binder == 1) # Bindestrich in der Langform?
	  {
	    
	    $ak_lemma = join ("-", @ak_array);
	    
	  }else{
	    
	    $ak_lemma = join ("&spvgev;", @ak_array); # Leerzeichen werden bei der Abkürzung durch Viertelgeviert ersetzt.
	  }
	@ret=$ak_lemma, $vorne,$lemma, $hinten;  
	
	
	
	
	
	
      }
}
1;