This is query.pl in view mode; [Download] [Up]
#
# perl-Unterprogramm, das die eigentliche PLZ-Umsetzarbeit macht.
#
#############################################################################
# Copyright (C) 1993
# Andreas Koppenhoefer (koppenh@dia.informatik.uni-stuttgart.de)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#############################################################################
# @(#)$Id: query.pl,v 1.6 1993/07/01 13:01:28 koppenh Exp $
# $Log: query.pl,v $
# Revision 1.6 1993/07/01 13:01:28 koppenh
# Runde Klammern werden nur noch am Zeilenanfang akzeptiert, da es einige
# Adressen gibt, die korrekterweise runde Klammern enthalten;
#
# Revision 1.5 1993/06/30 13:57:21 koppenh
# Verbesserung der Arbeitsweise der option -t;
#
# Revision 1.4 1993/06/29 16:28:16 koppenh
# Korrektur fuer NeXT-Umlaute;
#
# Eine Anfrage darf jetzt in runde Klammern gesetzte Angaben enthalten,
# die komplett ignoriert werden. Das ist nuetzlich mit der option '-t':
# Es koennen Angaben einer Datenbank (z.B. Benutzernummer einer
# Bibliothek) mitgeschleppt werden. Auswertung der umgesetzten Adressen
# wird einfacher, da ein Bezug zur orginal-Adresse vorhanden ist;
#
# 'W7500 Karlsruhe; Postfach 22 22' wurde seither nicht richtig
# umgesetzt wegen Fehler in umsda (Postamt Karlsruhe 11 fehlt in umsda!)
# workaround eingebaut;
#
# Revision 1.2 1993/06/15 15:38:36 koppenh
# Neue Release Nummer;
#
# Revision 1.1.0.4 1993/06/15 14:46:45 koppenh
# Schreibweise Strasse => Stra\377e korigiert;
# Hilfetext auf 20 statt 24 Zeilen limitiert;
# Doppelhausnummern, Hausnummernbereiche und -zusaetze
# mit Leerzeichen werden jetzt akzeptiert;
# bugfixes der Aenderungen von Version 1.1.0.2-1.1.0.3;
#
# Revision 1.1.0.3 1993/06/15 12:19:18 koppenh
# Meldung "Postfach nicht gefunden" statt "Zustellpostamt fehlt",
# falls ueberhaupt keine passende Postfachnummer gefunden wurde;
#
# Revision 1.1.0.2 1993/06/15 12:06:39 koppenh
# Postfachadressen werden hauefiger gefunden, wenn Zustellpostamt
# nicht stimmt, sonst aber das Postfach eindeutig ist;
# Statt 'Postfach' darf in Adresse auch 'P.O.B.' oder 'P.O.Box' stehen,
# Punkte und Leerzeichen sind hier optional;
#
# Revision 1.1.0.1 1993/06/08 19:11:21 koppenh
# NeXT Umlaute eingebaut
#
#############################################################################
# close all database files and locks and reset index variables
sub endquery {
close LOCKFILE if ($X_already_locked);
close UMSDA if ($#X_umsda_index >= $[);
close STRADA if ($#X_strada_index >= $[);
close POFADA if ($#X_pofada_index >= $[);
reset 'X';
}
#############################################################################
# single line query subroutine - pass old address as $_
local($exactquery);
sub query {
local($out);
local($origline);
if ($check_test) {
return ('') if m/^ALT: /;
s/^NEU: //;
$origline = &ascii2iso(&ibm2iso(&tex2iso($_)));
return ('') unless s/^(.*\S)\s*=\s*(\S.*)/\1/;
} else {
$exactquery = $_;
chop($exactquery);
alarm($looplogout);
}
# strip cr, tab and multible spaces, trailing nl
chop;
y/\r\t / /s;
# in Klammern gesetzte Angaben am Zeilenanfang ignorieren...
s/^\([^)]*\)//;
# Alle internen Ablauefe gehen ueber iso-Umlaut Darstellung.
$_ = &next2iso($_) if $use_next_output;
$_ = &ascii2iso(&ibm2iso(&tex2iso($_)));
# extrahiere Plz-Ost-West Unterscheidungsmerkmal
return(&bad_adr) unless s/^\s*([-WODXwodx]*)\s*//;
local($plz_zus_alt);
$plz_zus_alt = $1;
# Uebersetze alte D (BRD) und X (DDR) Kennzeichen
$plz_zus_alt = 'W' if (($plz_zus_alt =~ y/WDOXwdox-/WWOOWWOO/d) == '');
# extrahiere Plz-Nummer
return(&bad_adr("Bitte vierstellige Alt-PLZ verwenden."))
unless s/^(\d{1,4})\s*(\D)/\2/;
# mache aus ganz alten ein bis dreistelligen eine vierstellige PLZ
local($plz_alt);
$plz_alt = $1.('0' x (4-($1=~tr/0-9//)));
# extrahiere Ort, Zustellpostamtnr., Strasse/Postfach
# Ort muss mit einem Buchstaben anfgangen und hoert vor einer Zahl oder ';' auf.
return(&bad_adr) unless
m/^([A-Za-z\344\366\374\304\326\334\337][^;\d]*)\s*(\d*)[;\s]*(.*)$/;
local($ort_alt, $zspa, $strasse) = ($1, $2, $3);
# Korrigiere Schreibweisen etc.
$strasse =~ s/^\W+//;
$ort_alt =~ y,-a-zA-Z\,\./ \344\366\374\304\326\334\337,,cd;
$ort_alt =~ y/ //s;
$ort_alt =~ s/ *$//;
$ort_alt =~ s-/ *-, -;
# printf (" %s%4d %-32s %-3s; %-32s\n", $plz_zus_alt, $plz_alt, $ort_alt, $zspa, $strasse);
# Ok - jetzt folgt der erste Versuch
local($neu);
$neu = &umsda($plz_zus_alt.$plz_alt, $ort_alt, $zspa, $strasse);
# &umsda liefert bei Misserfolg string der Form
# /^\d\D/ : bei "fatalem" Misserfolg
# /^\w.*/ : Erfolgsmoeglichkeit bei Einzelabfragen von Doppelnamen
# Also, falls keine Plz gefunden und '-' im Ortsnamen vorkommt...
if ($neu !~ m/^\d/ && ($ort_alt =~ m/-\s*\D/)) {
# altes Ergebnis aufheben
local($firstneu, $firsthelp) = ($neu, $help);
$neu=$ort_alt;
# doppelnamen und Zusaetze abtrennen und nochmals versuchen
$neu =~ s/-\s*(\D*)//;
local($doppel);
$doppel = $1;
# erste Haelfte
$neu = &umsda($plz_zus_alt.$plz_alt, $neu, $zspa, $strasse);
# zweite Haelfte, falls noch immer kein Erfolg
$neu = &umsda($plz_zus_alt.$plz_alt, $doppel, $zspa, $strasse)
if ($neu !~ m/^\d/);
# Falls noch immer kein Erfolg, restauriere Ergebnis vom ersten Versuch
($neu, $help) = ($firstneu, $firsthelp) if ($neu !~ m/^\d/);
}
# Ausgabe vorbereiten
local($alt);
if (! $use_exact_query) {
# &iso2output bei $alt nicht noetig, da $alt in $neu eingebettet wird und
# beim return $neu komplett durch iso2output gejagt wird
# (wegen Umlaut-Kollisionen bei NeXT dann sogar falsche Ausgabe) D.Droege
# $alt = &iso2output("$plz_zus_alt$plz_alt $ort_alt $zspa; $strasse");
$alt = "$plz_zus_alt$plz_alt $ort_alt $zspa; $strasse";
$alt =~ s/ ;/;/;
$alt =~ s/ *$//;
} else {
$alt = $exactquery;
}
# Interne Informationen entfernen.
$neu =~ s/^\d //;
$neu =~ s/ *$//;
# Ausgabe formatieren
$neu = sprintf ("%-40s= $neu\n", $alt);
if ($check_test) {
$origline =~ s/ *$//;
$origline =~ y/ //s;
# Keine Ausgabe - nur Kontrolle.
local($compare) = $neu;
$compare =~ y/ //s;
if ($origline ne $compare) {
return('ALT: '.$origline.'NEU: '.$compare.$help);
} else {
return($neu.$help);
}
}
alarm(0);
# Protokollieren - damit ich auch sehen kann, wie gut das Programm arbeitet
# und ich neue Beispieldaten bekomme (ist das ok von wegen Datenschutz?)
&log_query($neu.$help);
return(&iso2output($neu.$help));
}
#############################################################################
# umsetzdatei durchsuchen
sub umsda {
$help = '';
local ($plz, $ort, $zspa, $strasse) = @_;
# oeffne Datei
&open_umsda;
# Ist Strasse eine Postfachangabe?
local ($postfach);
if ($strasse =~ m/^postfach([\s\d]*)$/i || # Postfach xyz
$strasse =~ m/^P\.?\s?O\.?\s?Box\.?([\s\d]*)$/i || # P.O.Box xyz
$strasse =~ m/^P\.?\s?O\.?\s?B\.?([\s\d]*)$/i || # P.O.B. xyz
$strasse =~ m/^PF([\s\d]*)$/i) { # PF xyz
$postfach = $1;
$postfach =~ y/0-9//cd;
$postfach = -1 if ($postfach < 1);
# $postfach < 0 falls Postfachadr. ohne Nr., > 0 ist es die Postfachnr.
#print $postfach."\n";
}
#print "umsda: $plz $ort $zspa; $strasse\n";
# erzeuge sortierschluessel
local ($sort, $sortlen);
$sort = &iso2umlaut($ort);
$sort =~ s/,[^,]*$//;
$sort =~ y/a-z/A-Z/;
$sort =~ y/A-Z//dc;
# binaere suche in @X_umsda_index und seek in umsda ...
seek (UMSDA, &indexsearch($sort.'-', *X_umsda_index), &SEEK_SET)
|| die "seek UMSDA '$sort' failed, aborted";
local ($plza, $oname_sort_a, $npanst_a, $ortname_a, $ortzusa,
$alort, $geschl, $nplz_z, $plz_z, $ortname_n);
local ($found);
local(%zspa, @zspa, $ort_gefunden, @orte, @orte_len, %orte, @orte_count, $max);
local($main, $main_zspa);
# Zum Vergleichen alles in Kleinbuchstaben.
local($lowerort) = ($ort);
$lowerort =~ tr/A-Z\304\326\334/a-z\344\366\374/;
local ($lowerort_abk) = &abkuerzung($lowerort);
$lowerort_abk = '' if ($lowerort_abk eq $lowerort);
local($longname, $lowerlong, $lowershort, $i, $j);
while (! eof(UMSDA) && ! $found) {
$_ = <UMSDA>;
chop;
($plza, $oname_sort_a, $npanst_a, $ortname_a, $ortzusa, $alort,
$geschl, $nplz_z, $plz_z, $ortname_n, $nplz_p, $plz_p, $oname24_n,
@rest)
= split(/:/);
# Voller Ortsname mit Zusatz:
$longname = $ortname_a.' '.$ortzusa;
$longname =~ s/\s*(\W)/\1/g;
$longname =~ s/\s*$//;
if ($plza eq $plz) {
($lowerlong, $lowershort) = ($longname, $oname_sort_a);
$lowerlong =~ tr/A-Z\304\326\334/a-z\344\366\374/;
$lowershort =~ tr/A-Z\304\326\334/a-z\344\366\374/;
# print "$sort|$lowershort|$lowerlong = $oname_sort_a|$lowerort|$lowerort_abk\n";
if ($sort eq $oname_sort_a
|| $lowershort eq $lowerort || $lowerlong eq $lowerort
|| $lowershort eq $lowerort_abk || $lowerlong eq $lowerort_abk) {
# gefunden
if ($npanst_a == $zspa) {
# Zustellpostamtsnr ist ok.
$found++;
} elsif (!$main || ($main_zspa > $npanst_a)) {
# Zustellpostamtsnr stimmt nicht, aber es koennte der
# einzige halbwegs passende Eintrag sein.
$main = $_;
# Merke Eintrag mit kleinster $npanst_a
$main_zspa = $npanst_a;
}
# Merke Zustellpostamtsnr fuer Hilfetext
push(@zspa, $npanst_a) unless ($zspa{$npanst_a}++);
}
}
if (! $found) {
# taucht plz.ort Paar zum ersten Mal auf?
if (! $orte{$plza.$longname}++) {
# Ja, ermittle Anzahl uebereinstimmender Anfangsbuchstaben
$j = $i = &count_eq_chars($sort, $oname_sort_a);
# Teil der Heuristik zur Ermittlung sinnvoller Hinweise
if ($i >= $max) {
for ($max = 0; $max < $i; $max++) {
$orte_count[$max] = 0;
}
} else {
while ($i-- > 0) {
$orte_count[$i]++;
}
}
if ($j) {
# Merke Ortsnamen und Grad der Uebereinstimmung fuer Hilfetext
push (@orte, $plza.' '.$longname);
push (@orte_len, $j);
}
} else {
next if (!eof(UMSDA));
}
# Pruefe, ob es sinnvoll ist, weiterzusuchen...
next if (($j > 1) && ($orte_count[0] < ($max_help_match<<2))
&& !eof(UMSDA));
# Ende der Suche - Gibt es einen einzelnen halbwegs passenden Eintrag?
if ($main) {
# Ja, aber mit falscher Zustellpostamtsnr.
($plza, $oname_sort_a, $npanst_a, $ortname_a, $ortzusa,
$alort, $geschl, $nplz_z, $plz_z, $ortname_n,
$nplz_p, $plz_p, $oname24_n, @rest) = split(/:/, $main);
$zspa = $npanst_a # einzig richtiges zustellpostamt
if ($#zspa = $[);
$found ++;
next; # ... weiter bei 'Ende der Suche'
} else {
# Wir habe keinen passenden Ort gefunden.
&format_help("Orte mit gleichen Anfangsbuchstaben",
@orte, @orte_len);
return "PLZ/Ort nicht gefunden";
}
}
}
# Ende der Suche - wir haben den Eintrag gefunden
# Falls neuer Ortsname eine Abkuerzung hat, verwende Abkuerzung.
if ($oname24_n ne '') {
$ortname_n = $oname24_n;
} else {
$ortname_n = $ortname_a
if ($ortname_n eq '');
}
# Merke Gemeindeschluessel fuer eine Landkreisliste etc.
$gemeindeschluessel{$geschl}++ if ($landkreisliste && $geschl);
if ($postfach) {
# Adresse ist ein Postfach...
if ($npanst_a < $zspa && $postfach > 0) {
# Versuchen wir's trotzdem ueber pofada
# In den Postdateien sind @#$%^ Inkonsitenzen...
local($neu) = &pofada ($plz, $ortname_a, $alort, $ortname_n,
$zspa, $postfach);
# Folgende Zeile ignoriert nplz_p in umsda falls &pofada
# erfolgreich ist.
return $neu if ($neu =~ m/^\d\d/);
}
if ($nplz_p == 1) {
# es gibt nur eine postfach-PLZ
return "$plz_p $ortname_n; ".&format_postfach($postfach);
}
if ($nplz_p < 1) {
return "0 Postamt $zspa hat keine Postfächer" if ($zspa > 0);
return "0 Ort hat keine Postfächer";
}
# ermittle aus pofada die neue PLZ
return (&pofada ($plz, $ortname_a, $alort, $ortname_n, $zspa, $postfach))
unless $postfach < 0;
# ohne postfachnummer keine Chance!
$help = "\tPostfachnummer benötigt.\n";
return "0 Ort hat mehrere Postfach-PLZ";
}
# Adresse ist eine Strasse
if ($nplz_z == 1) {
# es gibt nur eine zustell-PLZ
return "$plz_z $ortname_n; $strasse";
}
if ($nplz_z < 1) {
return "0 Postamt $zspa hat keinen Zustellbezirk" if ($zspa > 0);
# Kann folgendes sein? ... oder ist da wieder ein Fehler in den Dateien?
return "0 Ort hat keine neue Zustell-PLZ";
}
# Ort ist einer von den 209 Staedten mit Strassenverzeichnis...
return (&strada ($alort, $ortname_n, $zspa, $strasse, $plz, $ortname_a))
if $strasse =~ m/\w/;
$help = "\tStraßenangabe benötigt.\n";
return "0 Ort hat mehrere Zustell-PLZ";
}
#############################################################################
# Strassenverzeichnis durchsuchen
sub strada {
local ($ala, $ortname_n, $npanst_a, $strasse, $plz_a, $ortname_a) = @_;
# datei oeffnen
&open_strada;
# Weil viele Leute kein Leerzeichen zwischen Strassenabkuerzungen und
# der Hausnummer schreiben (z.B. "Albstr.79") mache ich eins 'rein!
# (==> "Albstr. 79")
$strasse =~ s/(\w)\.(\d)/\1. \2/g;
# Dafuer machen viele Leerzeichen zwischen Doppelhausnummern und
# Hausnummernbereiche 'rein - ich mache sie wieder 'raus.
# "Amalienstr 81 / 87" ==> "Amalienstr 81/87"
$strasse =~ s,(\d+)\s*([-/])\s*(\w+)\s*$,\1\2\3,;
# Bei Hausnummerzusaetze Leerzeichen entfernen
# "Sibyllenstr. 18 a" ==> "Sibyllenstr. 18a"
# Problematisch: "Strasse 229 a" ist Strassenname!
$strasse =~ s/(\d+)\s+([a-zA-Z]+)$/\1\2/
unless $strasse =~ m/^stra[s\337]{1,2}e \d+\D+$/i ;
#print "$strasse := ";
# Strassenangabe zerlegen in Name Hausnummer Zwischenraum und Zusatz
# Beispiel: "Katharienenstr. 4/II" ==> (Katharienenstr.)(4)(/)(II)
# problematisch: "W1000 Berlin; Strasse des 17. Juni 135"
# oder auch "W1000 Berlin; Strasse D 18 12" und "1000 Berlin; Strasse 229 a"
local ($strname, $hnr1, $delim, $hnr2, $rest, $sort, $sortlen);
if (($strasse !~ m/^stra[s\337]{1,2}e \d+\D*$/i) &&
(($strname, $hnr1, $delim, $hnr2, $rest) =
($strasse =~ m/^\W*(.+)\s+(\d+)([-\/]*)(\w*)\s*(\D*)$/))) {
$strasse = $strname;
$hnr2 = $rest if !$hnr2;
}
#print "<$strasse><$hnr1>$delim<$hnr2>\n";
# erzeuge sortierschluessel
$sort = &iso2umlaut($strasse);
$sort =~ y/a-z/A-Z/;
$sort =~ y/A-Z0-9//dc;
$sort =~ s/STRASSE$/STR/;
#printf "$ala %-30s %s\n", $sort, "$strasse =: <$strname> <$hnr1>$delim<$hnr2>";
local($alasort);
$alasort = substr($ala.$sort,0,$strada_index_len);
# print "$alasort $sort\n";
# binaere suche in @X_strada_index, Startpostition extrahieren und seek...
seek (STRADA, &indexsearch($alasort, *X_strada_index), 0)
|| die "seek STRADA '$alasort' failed, aborted";
$alasort .= '~';
local ($alort, $snamesort, $sname, $abkstr, $anzgleist, $nplz_z,
$hnrkenn, $hnr1von, $hnr2von, $hnr1bis, $hnr2bis, $plz_z);
local($strasse_gefunden, @other, @other_len, @hausnummern, %zspa, @zspa);
# Zum Vergleichen zusaetzlich alles in Kleinbuchstaben.
local($lowerstrasse) = $strasse;
$lowerstrasse =~ tr/A-Z\304\326\334/a-z\344\366\374/;
while (<STRADA>) {
chop;
($alort, $snamesort, $sname, $abkstr, $anzgleist, $nplz_z,
$hnrkenn, $hnr1von, $hnr2von, $hnr1bis, $hnr2bis, $plz_z,
$npanst, $ortsteil, $plzalt, @rest) = split(/:/);
local ($lowersname, $lowerabkstr) = ($sname, $abkstr);
$lowersname =~ tr/A-Z\304\326\334/a-z\344\366\374/;
$lowerabkstr =~ tr/A-Z\304\326\334/a-z\344\366\374/;
# print "$snamesort eq $sort || $strasse eq $sname || $strasse eq $abkstr\n";
if ($snamesort eq $sort || $strasse eq $sname || $strasse eq $abkstr || $lowerstrasse eq $lowersname || $lowerstrasse eq $lowerabkstr) {
$strasse_gefunden = $sname;
# print $_."\n$plzalt==$plz_a\n";
if ($anzgleist == 2) {
$key = "$plzalt $ortname_a $npanst";
$key .= " ($ortsteil)" if $ortname_a ne $ortsteil;
push(@zspa, $key) unless $zspa{$key}++;
next if (($npanst_a != $npanst) ||
$plzalt && ($plzalt ne $plz_a));
}
if ($nplz_z == 2) {
if ("$hnr1von$hnr2von" eq "$hnr1bis$hnr2bis") {
$key = "Nr. $hnr1von$hnr2von ($plz_z)";
} else {
$key = $hnrkenn ? ($hnrkenn==1 ? 'gerade ' : 'ungerade ') : '';
$key .= "von $hnr1von$hnr2von bis $hnr1bis$hnr2bis ($plz_z)";
}
push (@hausnummern, $key);
next if ($hnr1 < 1);
next if ($hnrkenn > 0 && (($hnr1%2+1) != $hnrkenn));
next if ($hnr1von > $hnr1 || $hnr1von==$hnr1 && $hnr2von gt $hnr2);
next if ($hnr1bis > 0 &&
($hnr1bis<$hnr1 || $hnr1bis==$hnr1 && $hnr2bis lt $hnr2));
} else {
die "strada fehlerhaft ($anzgleist/$nplz_z)"
if ($anzgleist < 1 || $nplz_z != 1);
}
# Falls $abkstr Feld leer ist, uebernehme $sname.
$abkstr = $sname unless $abkstr;
return "$plz_z $ortname_n; $abkstr $hnr1$delim$hnr2";
}
if (($#hausnummern >= $[) && ($sort lt $snamesort)) {
&format_help("Bekannte Hausnummernbereiche",
sort sort_by_hausnummer @hausnummern);
return "0 Stra\337e hat mehrere PLZ" if ($hnr1 < 1);
return "0 Hausnummer nicht gefunden";
}
if ($alort.$snamesort gt $alasort) {
if ($#zspa >= $[) {
&format_help("Zustellpostämter", sort @zspa);
return "Zustellpostamt ".($npanst_a?"falsch":"fehlt");
}
last;
}
if ($other[$#other] ne $sname) {
local($i);
$i = &count_eq_chars($snamesort, $sort);
if ($i) {
push(@other, $sname);
push(@other_len, $i);
}
}
}
#print STDERR "$strasse\n";
&format_help("Stra\337en mit gleichen Anfangsbuchstaben", @other, @other_len);
return "0 Stra\337e nicht gefunden";
}
sub sort_by_hausnummer {
local($aa, $bb) = ($a, $b);
$aa =~ s/^\D+(\d+).*/\1/;
$bb =~ s/^\D+(\d+).*/\1/;
$aa <=> $bb;
}
#############################################################################
# Postfachverzeichnis durchsuchen
sub pofada {
local ($plz, $ortname_a, $ala, $ortname_n, $npanst_a, $postfach) = @_;
&open_pofada;
#print "$plz $ortname_a $npanst_a\n";
local ($sort, $sortX);
$sort = $ala;
# binaere suche in @X_pofada_index und seek...
seek (POFADA, &indexsearch($sort, *X_pofada_index), 0)
|| die "seek POFADA '$sort' failed, aborted";
local ($ala, $npanst, $plz_a, $pfnrvon, $pfnrbis, $plzneu_p);
#printf ("$ala %3d %6d\n", $npanst, $postfach);
local (@zspa, %zspa, $zspa_gefunden, $plz_gefunden);
while (<POFADA>) {
(($ala, $npanst, $plz_a, $pfnrvon, $pfnrbis, $plzneu_p) =
m/^(\d{8})(.{3})([WO]\d{4})(.{6})(.{6})(\d{5})/) ||
die "pofada: line parse error, aborted";
#print join("\t", '', $plz_a, $npanst, $pfnrvon, $pfnrbis,
# $plzneu_p, "$plz_gefunden?", "ala $ala")."\n";
last if ($ala != $sort);
if (($npanst_a != $npanst) || ($plz ne $plz_a)) {
next if ($pfnrvon > $postfach || $pfnrbis < $postfach);
$plz_gefunden = $plzneu_p;
push(@zspa, "$plz_a $ortname_a $npanst")
unless ($zspa{$plz_a.$npanst}++);
next;
}
$zspa_gefunden++;
next if ($pfnrvon > $postfach || $pfnrbis < $postfach);
return "$plzneu_p $ortname_n; ".&format_postfach($postfach);
}
return "$plz_gefunden $ortname_n; ".&format_postfach($postfach)
if ($#zspa == $[);
&format_help("Postämter mit ".&format_postfach($postfach),
sort @zspa);
return "0 Postfach nicht gefunden" unless $plz_gefunden;
return "0 Zustellpostamt ".($npanst_a?"falsch":"fehlt");
}
#############################################################################
# formatiere Postfachnummer in zweiergruppen von hinten
sub format_postfach {
local($postfach) = @_;
return ("Postfach") if ($postfach < 1);
local($text);
while ($postfach) {
$text = sprintf("%02d %s", $postfach % 100, $text);
$postfach = int($postfach / 100);
}
$text =~ s/^0*([\d\s]*) $/Postfach \1/;
return ($text);
}
#############################################################################
# Umwandlung der Umlaute in Ausgabezeichensatz
sub iso2output {
return (@_[0]) if ($use_iso_output);
return (&iso2ibm(@_[0])) if ($use_ibm_output);
return (&iso2next(@_[0])) if ($use_next_output);
return (&iso2ascii(@_[0])) if ($use_ascii_output);
return (&iso2umlaut(@_[0])) if ($use_umlaut_output);
return (&iso2tex(@_[0])); # default
}
#############################################################################
# Oeffnen der Dateien und laden des index.
sub open_umsda {
return if ($#X_umsda_index >= $[);
&do_lock;
open (UMSDA, "<$localprefix$umsdafile.index")
|| die "$localprefix$umsdafile.index: $!, aborted";
@X_umsda_index = (<UMSDA>);
close UMSDA;
open (UMSDA, "<$localprefix$umsdafile.packed")
|| die "$localprefix$umsdafile.packed: $!, aborted";
}
sub open_strada {
return if ($#X_strada_index >= $[);
open (STRADA, "<$localprefix$stradafile.index")
|| die "$localprefix$stradafile.index: $!, aborted";
@X_strada_index = (<STRADA>);
close STRADA;
($strada_index_len, $rest) = split(/ /,$X_strada_index[0], 2);
$strada_index_len = length($strada_index_len);
open (STRADA, "<$localprefix$stradafile.packed")
|| die "$localprefix$stradafile: $!, aborted";
}
sub open_pofada {
return if ($#X_pofada_index >= $[);
open (POFADA, "<$localprefix$pofadafile.index")
|| die "$localprefix$pofadafile.index: $!, aborted";
@X_pofada_index = (<POFADA>);
close POFADA;
open (POFADA, "<$localprefix$pofadafile")
|| die "$localprefix$pofadafile: $!, aborted";
}
#############################################################################
# File Locking - damit nicht gleichzeitig das pack-Programm laufen kann bzw.
# damit wir merken, dass pack laeuft!
sub do_lock {
return unless $lockfile;
return unless $system_has_flock; # no flock available on some systems
return if ($X_already_locked++);
open (LOCKFILE, '<'.$lockfile) && (flock (LOCKFILE, &LOCK_SH|&LOCK_NB)) &&
return;
# warn "$lockfile: $!";
print STDERR
"PLZ-Datenbank voruebergehend nicht verfuegbar! Bitte spaeter erneut versuchen.\n";
exit 1;
}
#############################################################################
# Alle Anfragen in ein File 'reinschreiben.
# Grund: Sammeln von Testmaterial zum Debuggen.
# Problem: Ist das ok so von wegen Datenschutz?!
sub log_query {
local($text) = @_;
return unless $logfile;
open (LOG, '>>'.$logfile) || return;
if (! flock (LOG, &LOCK_EX|&LOCK_NB)) {
# wenn nicht, dann eben nicht...
close LOG;
# warn "logfile LOCK_EX failed";
return;
}
# zur sicherheit nochmals ans Ende postitionieren, denn ein anderer koennte
# zwischen open und flock schon etwas angefuegt haben.
if (seek (LOG, 0, &SEEK_END) < 0) {
# warn "logfile seek failed: $!";
return;
}
print LOG $text;
# Wenn wir das file gleich wieder schliessen, ist ein unlock nicht noetig.
# flock (LOG, &LOCK_UN|&LOCK_NB));
close LOG;
return;
}
#############################################################################
# Unterprogramm zum Hilfetextliste formatieren
sub format_help {
local($heading, @items) = @_;
return if ($#items < $[);
local($min);
# print join(':','-',$#items,@items)."\n";
if ($items[$#items] =~ m/^\d+$/ && $items[$[] !~m/^\d+/) {
# Zweiter Teil der Heuristik zur Ermittlung sinnvoller Hinweise
local(@itemprio) = splice(@items, ($#items>>1)+1);
local (@prio, $count, $i);
for ($i = $#itemprio; $i >= $[; $i--) {
for ($count = $itemprio[$i]; $count >= $[ ; $count--) {
$prio[$count]++;
}
}
$min = $#prio;
while($min > 3 && $prio[$min-1] <= $max_help_match) {
pop(@prio);
$min--;
}
local ($i);
local (@olditems) = @items;
@items = ();
for ($i = $[; $i < $#olditems; $i++) {
$olditems[$i];
push (@items, $olditems[$i]) if $itemprio[$i] >= $min;
}
}
# print join(':',$min,$#items,@items)."\n";
# Array @items wird jetzt zu einem Hilfetext zusammengesetzt.
local($line, $item, $linecount);
while ($item = shift(@items)) {
$item =~ s/^ +//;
$item =~ s/ +$//;
$item =~ y/ //s;
next unless $item;
if (length($line) + length($item) > 65) {
# Max. 65 Zeichen in einer Zeile (bei der Zaehlung
# das \t am Anfang nicht vergessen! Bei Umwandlung in ascii bei
# der Ausgabe, koennten es noch mehr Zeichen werden.
$help .= $line.";\n";
$line = "\t".$item;
if (++$linecount > 20) {
# Das sind entschieden zuviele Zeilen!!!
$help = '';
return;
}
} else {
$line .= $line ? '; ' : "\t";
$line .= $item;
}
}
$help .= $line."\n" if $line;
$help = "\t".$heading.":\n".$help if ($help);
}
#############################################################################
# Zaehle Anzahl der geminsamen Anfangsbuchstaben
# return (length+1) falls strings identisch
sub count_eq_chars {
return (length(@_[0])+1)
if (@_[0] eq @_[1]);
local(@c, @s, $i);
@c = split(//, @_[0]);
@s = split(//, @_[1]);
while ($#c >= $[ && shift(@c) eq shift(@s)) {
$i++;
}
return $i;
}
#############################################################################
# binaere Suche in einem index Array - return: seek index
sub indexsearch {
local($searchkey, *indexarray) = @_;
local ($left, $mid, $right, $key, $pos, $rest);
$left = $[; $right = $#indexarray - $[;
$searchkey .= "\177";
while ($left < $right) {
$mid = $left + (($right-$left+1) >> 1);
# printf "%4d %4d %4d %s", $left, $mid, $right, $indexarray[$mid];
if ($indexarray[$mid] lt $searchkey) {
$left = $mid;
} else {
$right = $mid-1;
}
}
# printf "%4d %4d %4d %s", $left, $left, $right, $indexarray[$left];
# Startpostition extrahieren
($key, $pos, $rest) = split (/[ \n]/, $indexarray[$left], 3);
return ($pos);
}
sub bad_adr {
if ($use_exact_query) {
$out = "$exactquery = Adressformat falsch oder unbekannt\n";
} else {
$out = "Adressformat falsch oder unbekannt: ".&iso2output($_."\n");
}
$out .= &iso2output("\t@_[0]\n") if @_[0];
alarm(0);
return($out);
}
1;
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.