This is server.pl in view mode; [Download] [Up]
#!/usr/local/bin/perl
eval "exec /usr/local/bin/perl $0 $*"
if $running_under_some_shell;
# this emulates #! processing on NIH machines.
#
# Hauptprogramm zur Umstellung alter Postleitzahlen auf neue.
#
#############################################################################
# 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: server.pl,v 1.5 1993/06/30 13:57:58 koppenh Exp $
# $Log: server.pl,v $
# Revision 1.5 1993/06/30 13:57:58 koppenh
# Nochmals NeXT-Umlaute;
#
# Revision 1.4 1993/06/29 17:14:25 koppenh
# Korrekturen NeXT-Umlaute, die bereits in Revision 1.2 eingebracht wurden,
# dann aber verloren gingen!?
#
# Revision 1.3 1993/06/29 16:32:56 koppenh
# Korrektur fuer NeXT-Umlaute;
#
# Revision 1.2 1993/06/15 15:38:36 koppenh
# Neue Release Nummer;
#
# Revision 1.1.0.2 1993/06/15 14:50:22 koppenh
# sub bye_bye schreibt jetzt nach STDERR;
#
# Revision 1.1.0.1 1993/06/08 19:10:22 koppenh
# server.pl achtet wie pack.pl auch auf $ENV{'PLZHOME'}
#
#############################################################################
#
# Optionen:
# -c wird vom rshd verwendet bei einem 'rsh host -l logname args'.
# Ohne -c werden Argumente, die nicht mit '-' beginnen als
# Dateien mit alten PLZ-Adressen angesehen, gelesen und
# uebersetzt.
# -i, -iso Output Umlaute in iso-Darstellung statt TeX.
# Beispiel: 'scriptname -i filename'
# -p, -ibm Output Umlaute in ibm-Darstellung statt TeX
# ('p' Synonym fuer PC).
# -a, -ascii Output Umlaute in 7bit-ascii-Darstellung statt TeX.
# -n, -next Output Umlaute in NeXT-Darstellung statt TeX.
#
# -l, -L Erzeugt nach Eingabe von EOF eine Landkreisliste fuer die
# angegebenen Orte. '-L' gibt auch kleinste Orte/Ortsteile sowie
# an die Landkreise angrenzenden Orte mit gleicher Alt-PLZ an.
# -t Wird zum Testen einer neuen Version benoetigt. Als Input sollte
# man die Ausgabe eines Programmablaufs einer aelteren Version
# verwenden. Dann erhaelt man die Unterschiede (Fehler?)
# ausgegeben.
# -u erwartet als Input eine Adressdatei mit festen
# Datensatzlaengen. Der Programmteil kann als Beispiel fuer
# andere Adressdateiformate dienen.
# -x Verwendet bei der Ausgabe des Ergebnisses die unveraenderte
# Orginalzeile zusammen mit dem Ergebnis.
$homedir = (getpwnam('plz'))[7];
push (@INC, $homedir) if $homedir;
$homedir = $ENV{'PLZHOME'} if $ENV{'PLZHOME'} && -d $ENV{'PLZHOME'};
$homedir =~ s,([^/])$,\1/,; # anhaengen von '/' falls nicht schon vorhanden
# Groesse der Hilfetexte in Zeilen (heuristik);
$max_help_match = 20;
# Automatischer Logout (exit) nach $autologout Sekunden Inaktivitaet
$autologout = 15*60; # 15 Minuten idle
$looplogout = 2*60; # nach zwei Minuten waehrend einer Anfrage (nur
# zur Sicherheit, falls Endlosschleifen im Script sind!)
$looplogout *= 5 if (-r '/xenix'); # mein xenix rechner ist langsam...
require 'common.pl';
require 'abkuerzung.pl';
require 'umlaut.pl';
require 'query.pl';
require 'landkreis.pl';
# Protokolliere nur wenn username 'plz' oder 'PLZ' ist
# alle anderen direkten Aufrufe nicht.
$login = getlogin || (getpwuid($<))[0] || "nobody";
$logfile = '' if ($login !~ m/^nobody$/ && $login !~ /^plz$/i);
# stdout Zeilengepuffert
select(STDOUT); $| = 1;
%printerlist = ('DPL24-D', 0x0031);
# printerlist value 0xAABC used as flag:
# AA identification number (not yet used)
# B 0:use_tex_output, 1:use_ibm_output, 2:use_iso_output, 3:use_ascii_output
# 4:use_next_output
# C index to %printerinit
@printerinit = ('', "\033\042\002\n");
# Optionen - muesste nochmals ueberarbeitet werden
while ($ARGV[0] =~ m/^-/) {
$ARGV = shift;
if ($ARGV =~ m/^(-\S+)\s+(\S.*)/) {
$ARGV = $1;
unshift (@ARGV, $2);
}
$use_ibm_output++ || next if ($ARGV eq '-ibm' || $ARGV eq '-p');
$use_iso_output++ || next if ($ARGV eq '-iso' || $ARGV eq '-i');
$use_ascii_output++|| next if ($ARGV eq '-ascii'|| $ARGV eq '-a');
$use_next_output++ || next if ($ARGV eq '-next' || $ARGV eq '-n');
$use_argv_adr++ || next if ($ARGV eq '-c');
$check_test++ || next if ($ARGV eq '-t');
$plz_umsetzen++ || next if ($ARGV eq '-u');
$landkreisliste =2 || next if ($ARGV eq '-l');
$landkreisliste =1 || next if ($ARGV eq '-L');
$use_exact_query++ || next if ($ARGV eq '-x');
if ($ARGV eq '-P') {
# Output to printer
if (! ($printertype = $printerlist{$ARGV = shift})) {
printf STDERR join (' ', "unknown printer type '$ARGV' - use ...\n",
sort keys %printerlist)."\n";
exit 1;
}
$use_ibm_output = ($printertype & 0xf0) == 0x10;
$use_iso_output = ($printertype & 0xf0) == 0x20;
$use_ascii_output = ($printertype & 0xf0) == 0x30;
$use_next_output = ($printertype & 0xf0) == 0x40;
next;
}
$no_usage++;
}
if ($landkreisliste) {
open (QOUT, '>&2');
} else {
open (QOUT, '>&1');
}
select (QOUT); $| = 1; select(STDOUT);
if ($system_has_getpriority) { # no getpriority available on some systems
# lower process priority by 1/3
local ($oldniceval) = getpriority(&PRIO_PROCESS, $$);
setpriority(&PRIO_PROCESS, $$, int((&PRIO_MAX-$oldniceval)/3+.67)+$oldniceval)
if ($oldniceval < &PRIO_MAX);
local ($newniceval) = getpriority(&PRIO_PROCESS, $$);
#print "priority changed from $oldniceval to $newniceval\n";
}
# single line query
if ($use_argv_adr && $#ARGV >= $[) {
$_ = join (' ', @ARGV);
$_ .= "\n";
print QOUT &query;
&landkreisliste;
exit 0;
}
while ($plz_umsetzen) {
# Ein Beispiel fuer eine Umsetzung: Die Quelldatei liegt in festem Blockformat
# von 160 Zeichen Laenge vor (ohne Datensatz-Endezeichen!)
local($stderrinfo) = 0;
if ($ARGV = shift) {
# Dateiname vorbereiten
$ARGV = "$cwd$ARGV" unless ($ARGV =~ m-^/-);
# read from specified file
open (ARGV, "<$ARGV") ||die "cannot read '$ARGV': $!\naborted";
# filegroesse ermitteln
$stderrinfo = (stat($ARGV))[7];
($stderrinfo % 160) &&
die "'$ARGV' has unexpected length\n($stderrinfo not modulo 160), aborted";
$stderrinfo /= 160; # Anzahl der erwarteten Datensaetze
# Datei fuer umgesetzte Adressen erzeugen und oeffnen
open (ARGVNEW, ">$ARGV.new") ||die "cannot create '$ARGV.new': $!\naborted";
# Fehlerprotokolldatei
open (ARGVOUT, ">$ARGV.out") ||die "cannot create '$ARGV.out': $!\naborted";
select(ARGVNEW); $| = 1;
select(ARGVOUT); $| = 1;
select(STDOUT);
} else {
# read from stdin
open (ARGV, "<&STDIN");
open (ARGVNEW, ">&STDOUT");
open (ARGVOUT, ">&STDERR");
}
local($old_line, $line_count, $result);
$line_count = 0;
# lese datensatz mit fester Laenge
while (! eof(ARGV) && read(ARGV, $old_line, 160) == 160) {
$line_count++;
# Zerlege Datensatz
local($other, $str, $plz, $ort) =
($old_line =~ m/^(.{85})(.{30})(.{15})(.{30})/);
# Versuche Umsetzung
$_ = $plz.$ort.';'.$str."\n";
$result = &query;
# Zerlege query-result
if ($result =~ m/^[^\n]*= (\d{5}) ([^;\n]+); *([^\n]*)\n/) {
# Erfolgreiche Umsetzung - baue neuen Datensatz zusammen
printf (ARGVNEW "$other%-30.30s%-15.15s%-30.30s", $3, $1, $2);
} else {
# Fehler - schreibe alten Datensatz
print (ARGVNEW $old_line);
}
# Schreibe Protokoll
$result =~ s/= /\n = /;
printf (ARGVOUT "(%04d) %s", $line_count, $result);
# Gebe Information ueber Bearbeitungsstand, falls Ausgabe nicht ueber STDOUT
printf (STDERR "%6.1f %% (%d/%d)\r",
($line_count/$stderrinfo)*100, $line_count, $stderrinfo)
if ($stderrinfo);
}
close (ARGVNEW);
close (ARGVOUT);
close (ARGV);
# exit if no more filenames
exit 0 if ($#ARGV < $[);
}
&usage unless $no_usage;
# main loop - Verlassen mit verschieden Signalen und Kommandos moeglich.
$SIG{'INT'} = $SIG{'QUIT'} = $SIG{'ALRM'} = $SIG{'TERM'} = 'bye_bye';
# idle timer starten
alarm($autologout);
local($repeated_usage) = 8;
while (<>) {
# Verschiedene Moeglichkeiten des Ausstiegs
&bye_bye if /^logo/i || /^quit/i || /^exit/i || /^bye/i || /^end/i || /^--/;
# Leere Eingabezeile ==> usage ausgeben
if (length($_) < 2) {
# ... aber nicht immer.
if ($repeated_usage-- < 1) {
&usage;
$repeated_usage = 8;
}
} else {
# und los geht's
print QOUT &query;
$repeated_usage = 0;
# idle timer ruecksetzen
alarm($autologout);
}
}
# Nach Ctrl-D bzw. EOF kommen wir hier her.
alarm(0);
&endquery;
&landkreisliste;
exit(0);
sub bye_bye {
print STDERR "\nPLZ-Ende - Alle Angaben ohne Gewaehr!\n";
exit 0;
}
#############################################################################
sub usage {
require 'version.pl';
select(STDERR); $| = 0;
print STDERR <<EndOfUsage;
Postleitzahl-Umstellung - Alle Angaben ohne Gewaehr!
$ProgVersion
$DataVersion
!! Perl-Skripte und zugehoerige Daten sind verfuegbar auf
!! ftp.informatik.uni-stuttgart.de (129.69.211.2) in pub/postleitzahlen
Geben Sie die alte Adresse in folgender Form ein (Ende mit Ctrl-D):
PLZ Ort; Strasse Hausnummer bzw. Postfach
Hausnummer bzw. Strasse und Hausnummer sind optional und sind vom Ort mit ';'
zu trennen. Achten Sie auf postalisch korrekte Schreibweise. Doppelorte mit
'-' schreiben. Umlaute ggf. aufloesen oder in tex-Notation (z.B. \"a). Falls
Ihnen die alte PLZ unbekannt ist, versuchen Sie es mit 9999.
Beispiele: W-7000 Stuttgart 80; Breitwiesenstra\"se 20/22
7000 Stuttgart 10; Postfach 10 60 37
Bitte melden Sie Programm- und Umsetzfehler per email an den Autor - Danke.
------------------------------------------------------------------------------
EndOfUsage
select(STDERR); $| = 1;
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.