Aktualisierungen zum Buch 
Web Content Management mit Perl
von Christian Hahn

Hier finden Sie neue Versionen von Listings aus dem Buch.
Bitte beachten Sie, dass nicht jedes Listing unverndert auf jeder Plattform lauffhig ist. Zudem hngt die Lauffhigkeit auch von der individuellen Konfiguration von Webserver und Datenbank sowie von der Perlversion ab. 

--------------------------------

Abschnitt 3.6 

Seite 90:
<link rel="stylesheet" href="/styles.css" type="text/css">

Seite 91:
$value{'stylesheet_file'} = "$ENV{'SCRIPT_NAME'}?stylesheet_file=1";

--------------------------------

Listing 6.3 

#!/usr/bin/perl

use strict;
use CGI;
use DBI;

require "common-lib.pl";
require "template-lib.pl";
require "sql-lib.pl";

my $cgi = new CGI;
my %args = $cgi->Vars;
my %value;

print "Content-type: text/html\n\n";
$value{'formaction'} = $ENV{'SCRIPT_NAME'};
parse_template("login.html", \%value);


--------------------------------

Listing 6.4 

sub auth_user {
  # 1. Argument: Hasharray mit CGI-Parametern
  my ($args) = @_;

  # Wurden Username / Passwort bergeben?
  if($$args{'username'} && $$args{'password'}) {
    my $sth = $main::dbh->prepare("select ID from user_account ".
	      "where username=\"$$args{'username'}\" and ".
              "password=\"$$args{'password'}\"");
    $sth->execute;
    if($sth->rows) {
      # Eintrag gefunden => Login-Daten korrekt, erzeuge Session
      srand($$|time);
      my $session_id = int(rand(60000));
      # time, die Prozess-ID, und eine Zufallszahl 
      # in Hexadezimalzahl wandeln:
      $session_id 
	= unpack("H*", pack("Nnn", time, $$, $session_id));
      $main::dbh->do("update user_account set ".
		     "session_id=\"$session_id\",".
		     "ip_addr=\"$ENV{'REMOTE_ADDR'}\",".
		     "last_access=".(scalar time).
		     " where username=\"$$args{'username'}\"");
      # Session-ID zurckgeben:
      return ($session_id, $$args{'username'});
    }
  }

  # Wurde Session-ID bergeben? Wenn ja, IP-Adresse berprfen:
  elsif($$args{'session_id'}) {
    my $sth = $main::dbh->prepare("select ip_addr, username,".
              "last_access from user_account where ".
              "session_id=\"$$args{'session_id'}\"");
    $sth->execute;
    my $ref=$sth->fetchrow_arrayref();
    my $time = scalar time;
    my $timeout = 1200; # Timeout von 1200 Sekunden
    # Timeout berprfen:
    if($time > ($$ref[2]+$timeout)) {
      logout($args);
      my %value = ();
      $value{'formaction'} = $ENV{'SCRIPT'};
      parse_template("login.html", \%value);
      exit;
    } else {
      $main::dbh->do("UPDATE user_account SET last_access=$time ".
		     "WHERE session_id=\"$$args{'session_id'}\"");
    }
    if($$ref[0] eq $ENV{'REMOTE_ADDR'}) { 
      # Daten korrekt, Session-ID und Username zurckgeben:
      return ($$args{'session_id'},$$ref[1]);
    }
  }

  # Ist berhaupt ein Useraccount in der DB vorhanden?
  else {
    my $sth=$main::dbh->prepare("select ID from user_account");
    $sth->execute;
    if(!$sth->rows) {
      first_time_login($args);
    }
  }
  
  # Weder Login-Daten noch Session-ID waren korrekt:
  return (0,0);
}


sub first_time_login {
  # 1. Argument: Hasharray mit CGI-Parametern
  my ($args) = @_;
  my %value;
  $value{'formaction'} = $ENV{'SCRIPT_NAME'};
  if($$args{"submit"}) {
    # Usereingaben berprfen:
    foreach my $field ("password","password2","username") {
      if(!$$args{$field}) { 
	$value{"username"} = $$args{"username"};
	$value{"required_fields_missing"} = 1;
	parse_template("first_time_login.html", \%value);
	exit 0;       
      }
    }

    # stimmen die Passworteingaben berein?
    if($$args{"password"} ne $$args{"password2"}) {
      $value{"passwords_dont_match"} = 1;
      parse_template("first_time_login.html", \%value);
      exit 0;
    }

    #ersten Administrator-Useraccount erstellen:
    $$args{"admin"} = 1;
    data_insert("user_account", $args);
    $value{"account_just_created"} = 1;
    parse_template("login.html", \%value);
    exit 0;

  } else {
    parse_template("first_time_login.html", \%value);
    exit 0;
  }
}


sub logout {
  # 1. Argument: Hasharray mit Variablenwerten
  my ($value) = @_;
  # Session-ID fr aktuellen User lschen:
  $main::dbh->do("update user_account set session_id=\"\" where session_id=\"$$value{'session_id'}\"");
}

return 1;


--------------------------------

Listing 6.5 

($value{'session_id'}, $value{'current_user'}) 
  = auth_user(\%args);
if(!$value{'session_id'}) { 
  parse_template("login.html", \%value);
  exit 0;
}
parse_template("success.html", \%value);


--------------------------------

Listing 6.8 

if($args{'logout'}) { 
  logout(\%value);
  parse_template("login.html", \%value);
  exit 0;
}


--------------------------------

Listing 8.8 

#!/usr/bin/perl

use strict;
use DBI;
use CGI;

require "common-lib.pl";
require "sql-lib.pl";
require "template-lib.pl";

print "Content-Type: text/html\n".
      "Expires: 0\n".
      "Pragma: no-cache\n\n";

my $cgi = new CGI;
my %args = $cgi->Vars;
my %value = ();

# Absenderadresse und Betreff der Besttigungs-E-Mails:
my $from_email = "info\@portaldienst.de";
my $subject = "Ihre Anmeldung zur Mailing-Liste";

$value{'formaction'} = $ENV{'SCRIPT_NAME'};

if($args{'submit'}) {
  # E-Mail schon in DB vorhanden?
  my $sth = $main::dbh->prepare(
    "SELECT ID FROM mailing_user ".
    "WHERE email LIKE \"%$args{'email'}%\"");
  $sth->execute();
  if($sth->rows) {
    parse_template("mailinglist_email_already_".
                   "exists.html", \%value);
  } else {
    # Anmeldung noch nicht besttigt
    $args{'approved'} = 0; 
    
    # Aktivierungsschlssel zur spteren 
    # Besttigung erzeugen:
    srand($$|time);
    my $activation_key = int(rand(60000));
    $activation_key = unpack("H*", 
      pack("Nnn", time, $$, $activation_key));
    $args{'activation_key'} = $activation_key;
    $args{'activation_url'} 
      = "$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}?".
        "activation_key=$activation_key";
    
    # Eingaben abspeichern:
    data_insert("mailing_user", \%args);

    # E-Mail mit URL zur Besttigung versenden:
    open FILE, "themes/txt/email.txt" or 
      die "can not open email.txt";
    my $text = join("",<FILE>);
    close FILE;
    # Variablen in E-Mail-Text einsetzen:
    $text =~ s/\$(\w+)\$/$args{$1}/g;
    if(send_mail($from_email, $args{'email'}, 
		 $subject, $text)) {
      parse_template("mailinglist_illegal_email.html", 
		     \%value);
      exit;
    }
    parse_template("mailinglist_thankyou_".
                   "registered.html", \%value);
  }
} else { 
  # Eingabeformular anzeigen:
  parse_template("mailinglist_member.html", \%value);
}


--------------------------------
