ich muss mich entschuldigen, ich dachte der quellcode ist zu lange, ich habe jetzt die - meiner Meinung - relevanten teile herausgegriffen (zur ergänzung: version des session-modules: 4.03, das geschilderte verhalten ist unabhängig davon, ob ich das ganze lokal unter xampp (windows) oder beim provider unter linux laufen lasse). wie schon gesagt: der fehler tritt auch auf, wenn ich entsprechende sub-routine (sub vorbereiten_mailing) gar nicht aufrufe. wenn der befehl ( $_uid=$session->param("uid");
) aus der subroutine entfernt wird und ausserhalb ausgeführt wird, tritt der fehler nicht auf.#! /usr/bin/perl -w
# Module laden
use strict;
use warnings;
use DBI;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Time::localtime;
use lib "/var/www/cgi-bin/lib";
use HTML::Template;
use CGI::Session;
#use CGI::Session::File;
my $session = new CGI::Session("driver:file",undef,{Directory=>'/var/www/cgi-bin/tmp'}) or die CGI::Session->errstr;
$session->expire("3600s");
my $cookie = $cgi->cookie(-name => $session->name, -value => $session->id);
#############################
### Hauptteil - Steuerung ###
#############################
my $aktion = $cgi->param('aktion');
my $template;
my @login;
my $local_uid;
my $local_kateg;
my $beherberger;
my $anz_datensaetze;
my ($userdef,$userdef1,$userdef2,$userdef3,$userdef4,$userdef5,%userdef_ges);
#loeschen# my ($eval_anrede, $eval_saison);
###################
### Login, etc. ###
###################
# erster Aufruf
if (!$aktion) {
print $cgi->header(-cookie=>$cookie);
print $cgi->start_html(-title=>'Directcom - Anmeldefenster',-style=>{-src=>'../directcom.css'});
# print $cgi->h1($session->dump());
my $template = new HTML::Template(filename => $templ . 'login.html');
$template->param('uid'=>'','pw'=>'');
print $template->output();
#kommt vom Loginfenster von einem Login-Vorgang
} elsif ($aktion eq 'einloggen') {
verbinden(); #Verbindung zur Datenbank herstellen
@login=fetch_pw($cgi->param('uid'));
#username noch nicht angelegt, Annahme: falsche Eingabe
if (!$login[0]) {
print $cgi->header(-cookie=>$cookie);
print $cgi->start_html(-title=>'Directcom - Anmeldefenster',-style=>{-src=>'../directcom.css'});
$template = new HTML::Template(filename=> $templ . 'login.html');
$template->param('uid_falsch'=>'1','uid'=>$cgi->param('uid'),'pw'=>'');
print $template->output();
#login _korrekt_ (eingegebenes pw stimmt mit gespeichertem überein und falsche Logins < 3
} elsif (($login[2] eq $cgi->param('pw')) && ($login[6] le 3)) {
loginfo_korr($login[0]);
print $session->header(-cookie=>$cookie); #schickt cookie im HTTP-Header mit
print $cgi->start_html(-title=>'DirectCom - Hauptfenster',-style=>{-src=>'../directcom.css'});
my $sess_uid = $cgi->param('uid');
$session->param('uid', $sess_uid); #uid wird für weiteres Verwenden in Session gesichert
$template = new HTML::Template(filename=> $templ . 'direct.html');
$template->param('ok'=>'1','betrieb'=>$login[3],'anzahl'=>$anz_datensaetze);
print $template->output();
# Login fehlgeschlagen (falsches Passwort)
} else {
# Zuviele Fehlversuche, Passwort gesperrt
if ($login[6] ge 2) {
print $cgi->header(-cookie=>$cookie);
print $cgi->start_html(-title=>'DirectCom - Zugang gesperrt',-style=>{-src=>'../directcom.css'});
$template = new HTML::Template(filename=> $templ . 'login.html');
$template->param('gesperrt'=>'1','uid'=>$login[1]);
print $template->output();
#eventuell angelegte session wird gelöscht
# $session->delete();
#weitere Versuche möglich
} else {
my $anz_versuche=loginfo_inkorr($login[0]);
my $remain = 3 - $anz_versuche;
print $cgi->header(-cookie=>$cookie);
print $cgi->start_html(-title=>'DirectCom - Zugang gesperrt',-style=>{-src=>'../directcom.css'});
$template = new HTML::Template(filename=> $templ . 'login.html');
$template->param('pw_falsch'=>'1','anzahl'=>$remain,'uid'=>'','pw'=>'');
print $template->output();
# $session->delete();
}
}
trennen();
#Ende Login-Behandlung
###################
### Subroutinen ###
###################
### Vorbereiten des Mailings, d.h. die passenden Datensätze bestimmen
sub vorbereiten_mailing {
my $_query = shift @_;
my @_datensatz;
my $zaehler;
my ($_uid, @_login, $_kateg);
$sth = $dbh->prepare(qq{$_query});
$sth->execute();
while (my $d = $sth->fetchrow_arrayref) {
push @_datensatz, {'id' => $d->[0].';'.$d->[1].';'.$d->[2].';'.$d->[3].';'.$d->[4].';'.$d->[5].';'.$d->[6].';'.$d->[7].';'.$d->[8].'.'};
$zaehler ++;
}
print $cgi->header();
print $cgi->start_html(-title=>'DirectCom - Datensuche',-style=>{-src=>'../directcom.css'});
$template = new HTML::Template(filename=> $templ . 'mailing.html', die_on_bad_params=>0);
my %mail_parameter;
#in Session gespeicherter Parameter uid wird zurückgeholt
##############################################
##############################################
### in der nächsten Zeile ist der Befehl, der entsprechende Befehl ###
##############################################
$_uid=$session->param("uid");
@_login=fetch_pw($_uid);
$_kateg=hole_kriterien(@login);
# Aufbereiten der Parameter zur erneuten Darstellung
if ($cgi->param('v1') eq 'ja') {
$mail_parameter{"v1"}=1;
} elsif ($cgi->param('v1') eq 'nein') {
$mail_parameter{"v_1"}=1;
}
if ($cgi->param('v2') eq 'ja') {
$mail_parameter{"v2"}=1;
} elsif ($cgi->param('v2') eq 'nein') {
$mail_parameter{"v_2"}=1;
}
if ($cgi->param('v3') eq 'ja') {
$mail_parameter{"v3"}=1;
} elsif ($cgi->param('v3') eq 'nein') {
$mail_parameter{"v_3"}=1;
}
if ($cgi->param('v4') eq 'ja') {
$mail_parameter{"v4"}=1;
} elsif ($cgi->param('v4') eq 'nein') {
$mail_parameter{"v_4"}=1;
}
if ($cgi->param('v5') eq 'ja') {
$mail_parameter{"v5"}=1;
} elsif ($cgi->param('v5') eq 'nein') {
$mail_parameter{"v_5"}=1;
}
$mail_parameter{"geogr"}=($cgi->param('geogr'));
$mail_parameter{"def1"}=($$ergebnis{'def1'});
$mail_parameter{"def2"}=($$ergebnis{'def2'});
$mail_parameter{"def3"}=($$ergebnis{'def3'});
$mail_parameter{"def4"}=($$ergebnis{'def4'});
$mail_parameter{"def5"}=($$ergebnis{'def5'});
$mail_parameter{"zaehler"}=$zaehler;
$template->param(%mail_parameter,personen => \@_datensatz);
print $template->output();
}
Datum: 24.03.2006-16:48
CGI::Session - Fehler durch Befehl in Subroutine
