#!/usr/bin/perl -w use strict; use CGI::Debug; use CGI; use DBI; =pod Detta är en uppkoppling mot databas jonas med tabell person: create table person (id serial, fnamn text, enamn text, fodd int); Datatypen serial räknar själv upp ett unikt nummer för varje ny skapad post. skriv "use CGI qw( :standard );" om du vill använda cgi-funktionerna utan CGI::-prefixt. =cut { my $dbname = 'jonas'; my $user = 'jonas'; my $passwd = 'jonas'; my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $user, $passwd) or die $DBI::errstr; print "Content-type: text/html\n\n"; my $state = CGI::param( 'state' ) || ""; if( $state eq 'list_records' ) { require "list_records.pm"; &list_records( $dbh ); } elsif( $state eq 'create_record_form' ) { &create_record_form( $dbh ); } elsif( $state eq 'create_record_result' ) { &create_record_result( $dbh ); } elsif( $state eq 'update_record_form' ) { &update_record_form( $dbh ); } elsif( $state eq 'update_record_result' ) { &update_record_result( $dbh ); } elsif( $state eq 'delete_record_result' ) { &delete_record_result( $dbh ); } elsif( $state eq 'view_record' ) { &view_record( $dbh ); } else { &menu; } $dbh->disconnect; exit; } #################################### sub topp { my $text = "Admin\n"; # Skriv ut lite debuggdata: $text .= "\n"; $text .= "
Indata till programmet\n"; foreach my $key ( CGI::param ) { my $value = CGI::escapeHTML( CGI::param( $key ) ); $text .= "
$key $value\n"; } $text .= "
\n"; return $text; } sub bottom { return "

Tillbaka till början \n"; } sub menu { print &topp; print "

Meny

\n"; print "
\n"; print "

State: Visa poster\n"; print "

State: Skapa ny post\n"; print "

\n"; print "

\n"; print ⊥ } sub view_record { my( $dbh ) = @_; my $id = CGI::param( 'id' ) or die "Du måste ange ett id"; my $sql = "select * from person where id=$id"; my $sth = $dbh->prepare( $sql ); $sth->execute or die( "< $sql > $DBI::errstr" ); my $rr = $sth->fetchrow_hashref or die "Kunde inte hitta en post med id $id"; # Se till så att fälten inte innehåller HTML-kod # Ge tomma fält sina defaultvärden my $fnamn = CGI::escapeHTML( $rr->{'fnamn'} ) || ""; my $enamn = CGI::escapeHTML( $rr->{'enamn'} ) || ""; my $fodd = CGI::escapeHTML( $rr->{'fodd'} ) || 0; print &topp; print "

Post nr $id

\n"; print "\n"; print "
Förnamn $fnamn\n"; print "
Efternamn $enamn\n"; print "
Födelseår $fodd\n"; print "
\n"; print "
\n"; print "

Id: \n"; print "

State: Uppdatera post\n"; print "

State: Radera post\n"; print "

\n"; print "

\n"; print ⊥ } sub create_record_form { my( $dbh ) = @_; print &topp; print "

Ny post

\n"; print "
\n"; print "\n"; print "
Förnamn \n"; print "
Efternamn \n"; print "
Födelseår \n"; print "
\n"; print "

State: Skapa\n"; print "

\n"; print "

\n"; print ⊥ } sub create_record_result { my( $dbh ) = @_; # Alla texter som ska in i databasen måste escapas med quote-metoden # Metoden översätter texten "Svennes' verkstad" till # "'svennes'' verkstad'". Odefinierade variabler översätts till # null my $fnamn = $dbh->quote( CGI::param('fnamn') ); my $enamn = $dbh->quote( CGI::param('enamn') ); my $fodd = CGI::param('fodd') || 0; my $sql = "insert into person ( fnamn, enamn, fodd ) values ( $fnamn, $enamn, $fodd)"; $dbh->do( $sql ) or die( "< $sql > $DBI::errstr" ); print &topp; print "

Ny post skapad

\n"; print "

Klart!\n"; print ⊥ } sub update_record_form { my( $dbh ) = @_; my $id = CGI::param( 'id' ) or die "Du måste ange ett id"; my $sql = "select * from person where id=$id"; my $sth = $dbh->prepare( $sql ); $sth->execute or die( "< $sql > $DBI::errstr" ); my $rr = $sth->fetchrow_hashref or die "Kunde inte hitta en post med id $id"; # Se till så att fälten inte innehåller HTML-kod # Ge tomma fält sina defaultvärden my $fnamn = CGI::escapeHTML( $rr->{'fnamn'} ) || ""; my $enamn = CGI::escapeHTML( $rr->{'enamn'} ) || ""; my $fodd = CGI::escapeHTML( $rr->{'fodd'} ) || 0; print &topp; print "

Post nr $id

\n"; print "
\n"; print "\n"; print "
Id \n"; print "
Förnamn \n"; print "
Efternamn \n"; print "
Födelseår \n"; print "
\n"; print "

State: Uppdatera\n"; print "

\n"; print "

\n"; print ⊥ } sub update_record_result { my( $dbh ) = @_; # Alla texter som ska in i databasen måste escapas med quote-metoden # Metoden översätter texten "Svennes' verkstad" till # "'svennes'' verkstad'". Odefinierade variabler översätts till # null my $id = CGI::param( 'id' ) or die "Du måste ange ett id"; my $fnamn = $dbh->quote( CGI::param('fnamn') ); my $enamn = $dbh->quote( CGI::param('enamn') ); my $fodd = CGI::param('fodd') || 0; my $sql = "update person set fnamn=$fnamn, enamn=$enamn, fodd=$fodd where id=$id"; $dbh->do( $sql ) or die( "< $sql > $DBI::errstr" ); print &topp; print "

Uppdatering av post $id

\n"; print "

Klart!\n"; print ⊥ } sub delete_record_result { my( $dbh ) = @_; my $id = CGI::param( 'id' ) or die "Du måste ange ett id"; my $sql = "delete from person where id=$id"; $dbh->do( $sql ) or die( "< $sql > $DBI::errstr" ); print &topp; print "

Radering av post $id

\n"; print "

Klart!\n"; print ⊥ } __END__