#!/usr/local/sisis-pap/bin/perl -w
#
# Realisierung einer cgi-Schnittstelle zur Sisis-Datenbank
# Zweck: Suchen von Namen, Benutzernummern. Auth. von Bennr/Pwd.
#
# Ausgabe des Programmes in html.
# Codes zur Programm-Weiterverarbeitung als Kommentar im html:
# Erfolgreich: findet sich im html-Quelltext
# Fehler: findet sich im html-Quelltext
# Diese Codes sind umdefinierbar
#
# misc, 9/07
#
use lib "/usr/local/sisis-pap/lib/perl5/site_perl/5.8.8/i686-linux-thread-multi-ld";
use lib "/usr/local/sisis-pap/lib/perl5/site_perl/5.8.8";
use lib "/usr/local/sisis-pap/lib/perl5/site_perl";
use DBI;
use CGI;
our $version="$0, 1.0, 9/07, Michael.Schaarwaechter\@ub.uni-dortmund.de";
our $query=new CGI;
our $servername;
# Config Start ###############
# Passwort welches per POST/GET mitgeliefert werden muss (accesspassword=...), damit Anfrage authentifiziert ist
our $accesspassword="main-access-passwort";
# Eigene URL fuer Weiterverzweigung von Benutzernamensuche auf Benutzerdatenanzeige
our $ownurl=qq#/cgi-bin/sisiscgi.pl#;
# Codes im html-Text, mit denen maschinell das Ergebnis der Anfrage geprueft werden kann
# Nicht aendern, da diese in anderen Programmen verwendet werden!
our $codeerror=qq##;
our $codesuccess=qq##;
our $codesperre=qq##;
our $codenosperre=qq##;
# Datenbankzugriff
our $dbuser = "sisis";
our $dbpassword ; # wird ganz unten festgelegt
my $conn = "dbi:Sybase:server=sisisSYB;database=sisis";
$ENV{'SYBASE'} = '/opt/sybase';
# Config Ende ################
# ------------------------------------------------------
sub datum {
my @time;
@time=localtime;
my $y=$time[5]+1900;
my $m=$time[4]+1;
my $d=$time[3];
my $hour=$time[2];
my $min=$time[1];
my $sec=$time[0];
$sec="0".$sec if (length($sec)==1);
$min="0".$min if (length($min)==1);
$hour="0".$hour if (length($hour)==1);
$d="0".$d if (length($d)==1);
$m="0".$m if (length($m)==1);
return $d.".".$m.".".$y." ".$hour.":".$min.":$sec";
}
# ------------------------------------------------------
sub openconnection {
our $dbh = DBI->connect($conn, $dbuser, $dbpassword, {ChopBlanks=>'true'} ) or die "Abbruch bei connect : $DBI::errstr\n";
}
# ------------------------------------------------------
sub closeconnection {
$dbh->disconnect;
}
# ------------------------------------------------------
sub ausgabestart {
my $title = (shift or "Sisis-Benutzer-Recherche");
print $query->header;
print << "EOT";
$title
EOT
}
# ------------------------------------------------------
sub ausgabeende {
print qq#
$version am #.&datum ;
print $query->end_html;
}
# ------------------------------------------------------
sub fehler {
my $meldung=shift || "Falsche(r) oder fehlende(r) Parameter! Bitte Rücksprache mit EDV.";
print qq#
Fehler: $meldung
#;
}
# ------------------------------------------------------
sub auth {
if ( (not defined $query->param("user")) or
(not defined $query->param("pass")) ) {
&fehler("Benutzernummer und/oder Passwort fehlen!");
return;
}
my $user=$query->param("user");
my $pass=$query->param("pass");
if (not $user=~m/^\d+$/) {
&fehler("Benutzernummern sind rein numerisch!");
return;
}
while (length($user)<11) {$user="0".$user}
&openconnection;
my $select= q{
select d02bnr,d02opacpin,d02sp1 from d02ben where d02bnr=? and d02bg<80 and d02bg !=41
};
my $sth = $dbh->prepare($select) or die "Can't prepare statement: $DBI::errstr";
$sth->execute($user) or die "Can't execute statement: $DBI::errstr";
my ($gotbnr,$gotpwd,$gotsperre) = $sth->fetchrow_array;
$sth->finish;
&closeconnection;
print qq#
Recherche nach Benutzernummer/Passwortkombination
#;
print qq#
Server:
$servername
Benutzernummer:
$user
Passwort:
$pass
Ergebnis:
#;
if ($user ne $gotbnr) {
print qq#Fehler: Die Benutzernummer wurde nicht gefunden!$codeerror#;
} elsif ($pass ne $gotpwd) {
print qq#Fehler: Das Passwort passt nicht zur Benutzernummer!$codeerror#;
} else {
print qq#OK: Das Passwort passt zur Benutzernummer.$codesuccess#;
}
print qq#
#;
if ($user eq $gotbnr) {
if ($gotsperre) {
print qq#
Sperre:
Benutzer ist gesperrt!$codesperre
#;
} else {
print qq#
Sperre:
Benutzer ist nicht gesperrt!$codenosperre
#;
}
}
print qq#
Stand
#.&datum.qq#
#;
print qq#
#;
}
# ------------------------------------------------------
sub getbendata {
my %felderhash=(
"d.d02bnr" => "Benutzernummer",
"d.d02vname" => "Vorname",
"d.d02name" => "Nachname",
"d.d02o1" => "Wohnort 1",
"d.d02s1" => "Strasse 1",
"d.d02p1" => "PLZ 1",
"d.d02anrede" => "Anrede",
"d.d02gedatum" => "Geb.Datum",
"d.d02ladatum" => "Letzte Aktivität",
"d.d02awdatum" => "Ausweisgültigkeit",
"d.d02so1" => "Kontostand Gebühren",
"d.d02avanz" => "Kontostand Ausleihen",
"d.d02pflanz" => "Kontostand PFL",
"d.d02vlanz" => "Anzahl akt. Verlängerungen",
"d.d02branz" => "Anzahl akt. Buchrückforderungen",
"d.d02maanz" => "Anzahl gemahnter Medien",
"d.d02sp1" => "Sperrgrund 1",
"d.d02sp2" => "Sperrgrund 2",
"d.d02d1sperre" => "Datum Sperre 1",
"d.d02d2sperre" => "Datum Sperre 2",
"d.d02datauf" => "Datum der Aufnahme",
"d.d02bg" => "Benutzergruppe (Nr)",
"d.d02sex" => "Geschlecht",
"d.d02fakul" => "Fakultät",
"d.d02jgdatum" => "Fälligkeit Jahresentgelt",
"d.d02opacpin" => "Opac-PIN",
"d.d02sljanz" => "Ausleihzähler lfd. Jahr",
"d.d02svjanz" => "Ausleihzähler Vorjahr",
"d.d02pinfalsch" => "PIN-Falscheingabe",
"z.d02z_bnr" => "Benutzernummer",
"z.d02fremd_nr" => "Matrikelnummer",
"z.d02z_str" => "Strasse (2)",
"z.d02z_plz" => "PLZ (2)",
"z.d02z_ort" => "Ort (2)",
"z.d02anschr" => "Zusatz",
"z.d02z_anschr" => "Zusatz (2)",
"z.d02tel" => "Telefon",
"z.d02z_tel" => "Telefon (2)",
"z.d02fax" => "Fax",
"z.d02z_fax" => "Fax (2)",
"z.d02z_mobil" => "Mobil-Nr",
"g.d61bgr" => "Benutzergruppe",
"g.d61gruppe" => "Benutzergruppe (Name)"
);
my @ausgabereihenfolge=qw(d.d02anrede d.d02vname d.d02name d.d02sex d.d02bg g.d61gruppe d.d02fakul z.d02fremd_nr d.d02opacpin d.d02pinfalsch d.d02ozeile z.d02anschr d.d02s1 d.d02p1 d.d02o1 z.d02z_mobil z.d02tel z.d02fax z.d02z_anschr z.d02z_str z.d02z_plz z.d02z_ort z.d02z_tel z.d02z_fax d.d02gedatum d.d02datauf d.d02jgdatum d.d02sp1 d.d02d1sperre d.d02sp2 d.d02d2sperre d.d02ladatum d.d02awdatum d.d02so1 d.d02avanz d.d02pflanz d.d02vlanz d.d02branz d.d02maanz d.d02sljanz d.d02svjanz );
my $rot="d.d02sp1 d.d02sp2"; # Roter Hintergrund bei diesen Feldern, durch Leerzeichen getrennt
my $gelb="d.d02opacpin d.d02vname d.d02name"; # Gelber Hintergrund, dito
my @felderarray=(sort keys %felderhash);
my $felderstring=join(", ", @felderarray);
if (not defined $query->param("user")) {
&fehler("Benutzernummer fehlt!");
return;
}
my $user=$query->param("user");
if (not $user=~m/^\d+$/) {
&fehler("Benutzernummern sind rein numerisch!");
return;
}
while (length($user)<11) {$user="0".$user}
&openconnection;
my $select= qq{
select $felderstring from d02ben as d, d02zus as z, d61bgr as g where d02bnr=? and d.d02bnr=z.d02z_bnr and g.d61bgr=d.d02bg
};
my $sth = $dbh->prepare($select) or die "Can't prepare statement: $DBI::errstr";
$sth->execute($user) or die "Can't execute statement: $DBI::errstr";
my @ergebnisarray = $sth->fetchrow_array;
my %ergebnishash;
if (scalar(@ergebnisarray)) {
foreach my $bezeichner(sort keys %felderhash) {
$ergebnishash{$bezeichner} = shift @ergebnisarray;
}
}
$sth->finish;
print qq#
Recherche nach Benutzerdaten
#;
print qq#
Server:
$servername
Benutzernummer:
$user
#;
if ($user ne $ergebnishash{"d.d02bnr"}) {
print qq#
Ergebnis:
Fehler: Die Benutzernummer wurde nicht gefunden!$codeerror
#;
} else {
# E-Mail-Adressen holen
$select= qq{
select d02obnr,d02oart,d02ozeile from d02onl where d02obnr=?
};
$sth = $dbh->prepare($select) or die "Can't prepare statement: $DBI::errstr";
$sth->execute($user) or die "Can't execute statement: $DBI::errstr";
while (my ($obnr,$oart,$ozeile)=$sth->fetchrow_array) {
if ($oart eq "1") {
$felderhash{"d.d02ozeile"}="E-Mail";
$ergebnishash{"d.d02ozeile"}.=" $ozeile";
}
}
$sth->finish;
# Sperrgruende holen
if (($ergebnishash{"d.d02sp1"} or $ergebnishash{"d.d02sp2"})) {
$select= qq{
select d65text from d65param where d65typ=2 and d65nr=?
};
$sth = $dbh->prepare($select) or die "Can't prepare statement: $DBI::errstr";
foreach $sperre("d.d02sp1","d.d02sp2") {
if ($ergebnishash{$sperre}) {
$sth->execute($ergebnishash{$sperre}) or die "Can't execute statement: $DBI::errstr";
my ($sperrgrund)=$sth->fetchrow_array;
$sperrgrund="?" if (not $sperrgrund);
$ergebnishash{$sperre}.= " = $sperrgrund";
}
}
$sth->finish;
}
# Anrede holen
if ($ergebnishash{"d.d02anrede"}) {
$select= qq{
select d65text from d65param where d65typ=1 and d65nr=?
};
$sth = $dbh->prepare($select) or die "Can't prepare statement: $DBI::errstr";
$sth->execute($ergebnishash{"d.d02anrede"}) or die "Can't execute statement: $DBI::errstr";
my ($anredetext)=$sth->fetchrow_array;
$anredetext="?" if (not $anredetext);
$ergebnishash{"d.d02anrede"}.= " = $anredetext";
$sth->finish;
}
# Ausgabe
my $bg;
foreach $bezeichner(@ausgabereihenfolge) {
$bg="";
$bg=qq# class="bgrot"# if ($rot=~m/$bezeichner/);
$bg=qq# class="bggelb"# if ($gelb=~m/$bezeichner/);
print qq#
$felderhash{$bezeichner}
$ergebnishash{$bezeichner}
\n# if ($ergebnishash{$bezeichner});
}
}
print qq#
Stand
#.&datum.qq#
#;
print qq#
#;
&closeconnection;
}
# ------------------------------------------------------
sub getnames {
my ($vnam,$nnam,$vnam2show,$nnam2show);
my $formstart=<
FE
if (
((not defined $query->param("vnam") and (not defined $query->param("nnam"))))
or
((length($query->param("vnam"))<3) and (length($query->param("nnam"))<3))
) {
&fehler("Bitte mindestens drei Buchstaben bei Vor- und/oder Nachnamen eingeben!");
return;
}
if ( ($query->param("vnam")!~m/^[a-zöäüA-ZÖÄÜß]*$/) or ($query->param("nnam")!~m/^[a-zöäüA-ZÖÄÜß]*$/) ) {
&fehler("Bitte nur Buchstaben eingeben. Trunkierung erfolgt automatisch.");
return;
}
if (not $query->param("vnam")) {
$vnam=q#%#;
$vnam2show="*";
} else {
$vnam2show="*".$query->param("vnam")."*";
$vnam=q#%#.lc($query->param("vnam")).q#%#;
}
if (not $query->param("nnam")) {
$nnam=q#%#;
$nnam2show="*";
} else {
$nnam2show="*".$query->param("nnam")."*";
$nnam=q#%#.lc($query->param("nnam")).q#%#;
}
#system("echo piep1 >> /tmp/blah.txt");
&openconnection;
my $select= qq#
select d02bnr,d02vname,d02name from d02ben where lower(d02vname) like ? and lower(d02name) like ? order by d02name
#;
#system("echo $select >> /tmp/blah.txt");
my $sth = $dbh->prepare($select) or die "Can't prepare statement: $DBI::errstr";
#system("echo piep2 >> /tmp/blah.txt");
$sth->execute($vnam,$nnam) or die "Can't execute statement: $DBI::errstr";
#system("echo piep3 >> /tmp/blah.txt");
print qq#
Recherche nach Benutzernummern
#;
print qq#
Server:
$servername
Suche nach
Vorname=$vnam2show
Nachname=$nnam2show
Benutzernummer
Vorname
Nachname
#;
my ($gotbnr,$gotvnam,$gotnnam);
my $counter=0;
while ( ($gotbnr,$gotvnam,$gotnnam) = $sth->fetchrow_array ) {
print qq#
$gotbnr
$gotvnam
$gotnnam
$formstart"$gotbnr"$formende
#;
$counter++;
}
if (not $counter) {
print qq#
Keine Ergebnisse!
#;
}
print qq#
$counter Ergebnisse
# if ($counter);
print qq#
Stand
#.&datum.qq#
#;
print qq#
#;
$sth->finish;
&closeconnection;
}
# ------------------------------------------------------
# ------------------------------------------------------
open PIPE,"uname -n|";
$servername=;
chomp $servername;
close PIPE;
$dbpassword="einpasswort" if ($servername eq "unsertestserver");
$dbpassword="einanderespasswort" if ($servername eq "unserproduktionsserver");
&ausgabestart;
if (not defined $query->param("accesspassword")) {
&fehler("Passwort geschützter Zugang, Passwort fehlend!");
} elsif ($query->param("accesspassword") ne $accesspassword) {
&fehler("Passwort geschützter Zugang, Passwort falsch!");
} else {
if (not defined $query->param("order")) {
&fehler;
} elsif (lc($query->param("order")) eq "auth") {
&auth;
} elsif (lc($query->param("order")) eq "getbendata") {
&getbendata;
} elsif (lc($query->param("order")) eq "getnames") {
&getnames;
}
}
&ausgabeende;