Datenbank basierte Linkseite
Vorarbeiten
Das Skript sollte sinvoller Weise in einem mit .htaccess geschützten Verzeichnis liegen, damit nicht jeder
es ausführen kann.
Jetzt benötigen wir noch zusätzlich das Modul Date::Manip
. Dieses Modul erlaubt eine einfache
Datumsmanipulation, wie der Name ja schon sagt Dazu besorgen wir
uns aus dem CPAN das momentan aktuelle
DateManip-5.40.tar.gz.
Funktionsweise
Das Einbinden der Module und die Konfiguration der Variablen geschieht in den Zeilen 1-57, ganz analog zu
links.cgi. Dann geben wir mit der Unterroutine http_header
einen
gültigen HTTP Header und eine Überschrift aus. In den Zeilen 62-95 wird festgelegt wie das Skript auf die
unterschiedlichen Anfragen im Query String reagieren soll. Danach werden noch die Gruppennamen aus der
Datenbank gelesen und als Links ausgegeben. Damit kann man an die gewünschte Kategorie in der Anzeige
springen. Des weiteren werden zwei weitere Links ausgegeben. Zum
einen ein Aufruf des Programmes kat_admin.cgi, und der
Aufruf des Programmes links.cgi. Zum Schluß folgt noch ein Formular mit den
Eingabefeldern: name
und URL
, sowie ein Auswahlfeld, zum auswählen der zugehörigen
Kategorie. Dieses Auswahlfeld wird aus dem Hash %kat
erzeugt, der als keys
die
Gruppennamen und als values
die Gruppenid's enthält. Beim Auswählen wird in einem
hidden_field
die Gruppenid gesetzt. Außerdem werden noch die Buttons "Eintragen",
"Ändern" und "Löschen" erzeugt.
Die restliche Funktionsweise ist dem Skript kat_admin.cgi analog angelegt.
Es muß hier nicht geprüft werden, ob die Gruppe gelöscht werden darf, da wir ja die Links bearbeiten.
Zusätzlich erfolgt die Ausgabe der Links analog zu links.cgi, hier wird beim
Betätigen eines Links das Skript erneut aufgerufen und das Formular mit dem ausgewählten Link vorbelegt.
Des weiteren erzeugen wir mit der Funktion UnixDate
aus Date::Manip
ein Zeitstempel
mit dem Format JJJJ-MM-TT HH:MM:SS
. Das war's dann schon.
Das Skript
Das Programm steht als Text Datei hier zum Download bereit.
1 #!/usr/bin/perl -w 2 3 use CGI qw/:standard :netscape/; 4 use strict; 5 use CGI::Carp qw/fatalsToBrowser/; 6 use DBI; 7 use URI::Escape; 8 use Date::Manip qw/UnixDate/; 9 10 ############################################### 11 # Copyright 1999 Dr Thomas Wieland 12 # wieland@thwieland.de 13 # für www.perl-stammtisch.de 14 ############################################### 15 16 # Methode für Formular 17 my $method = 'POST'; 18 19 # Hintergrundfarbe 20 my $bgrdcl = '#EEEEEE'; 21 22 # Titel der Seite 23 my $page_title = "Linkseite"; 24 25 # Bild für die Überschrift 26 my $title_gif = "linklogo.gif"; 27 28 # Bild für den Homepagebutton 29 my $homepage_gif = "homepage.gif"; 30 31 # Pfad zu den Bildern ausgehend vom Root Verzeichnis des httpd 32 my $icons = '/images'; 33 34 # Adresse des Adminskripts (zum Löschen von Einträgen) Kategorien 35 my $kadminurl = 'http://localhost/cgi-bin2/mydir/kat_admin.cgi'; 36 37 # Adresse des Linkseitenskripts 38 my $linkurl = 'http://localhost/~wieland/eins/cgi-bin2/links.cgi'; 39 40 # Adresse des Adminskripts (zum Löschen von Einträgen) Links 41 my $link_adminurl = 'http://localhost/cgi-bin2/mydir/link_admin.cgi'; 42 43 # Url der Homepage 44 my $homeurl = 'http://localhost/'; 45 46 47 # Variablen für Datenbank 48 my ($dbh, $sth, $sql, $row, $rv, %kat, %katnames); 49 my $db_type = 'mysql'; 50 my $port = 0; 51 my $hostname = "localhost"; 52 my $db_name = 'perl_stammtisch'; 53 my $DB_DSN = "DBI:$db_type:$db_name:$hostname:$port:"; 54 my $DB_USER = "perl_stammtisch"; 55 my $DB_PASSWD = ""; 56 my $Tab_Links = 'links'; 57 my $Tab_Link_Kat = 'link_kat'; 58 59 # Http Header, Kopf und Überschrift 60 &http_header; 61 62 # Datenbank Verbindung herstellen 63 $dbh = DBI->connect($DB_DSN, $DB_USER, $DB_PASSWD, 64 { RaiseError => 1 } ); 65 66 67 # Falls Parameter insert -> Einfügen 68 if (param('insert')) { 69 my $name = param('name'); 70 my $stamp = UnixDate(scalar localtime, "%Y-%m-%d %H:%M:%S"); 71 my $url = param('url'); 72 my $grpid = param('grpid'); 73 $sql = qq[ INSERT into $Tab_Links 74 (url, name, stamp, grpid) 75 VALUES('$url', '$name', '$stamp', '$grpid') ]; 76 $dbh->do($sql); 77 Delete_all(); 78 } elsif (param('edit')) { 79 my $name = param('name'); 80 my $nr = param('nr'); 81 my $stamp = UnixDate(scalar localtime, "%Y-%m-%d %H:%M:%S"); 82 my $url = param('url'); 83 my $grpid = param('grpid'); 84 $sql = qq[ UPDATE $Tab_Links 85 SET linkid='$nr', name='$name', 86 url='$url', stamp='$stamp', grpid='$grpid' 87 WHERE linkid='$nr' ]; 88 $dbh->do($sql); 89 Delete_all(); 90 } elsif (param('delete')) { 91 my $nr = param('nr'); 92 $sql = qq[ DELETE FROM $Tab_Links WHERE linkid='$nr']; 93 $dbh->do($sql); 94 Delete_all(); 95 } 96 97 &kat; 98 &formular; 99 &links; 100 101 # Datenbank Verbindung lösen 102 $dbh->disconnect(); # Datenbankverbindung lösen. 103 104 print end_html(); 105 106 # Unterprogramme 107 108 ############################################### 109 sub http_header { 110 ############################################### 111 print header(), 112 start_html( -BGCOLOR => $bgrdcl, 113 -title => $page_title, 114 -author => 'wieland@thwieland.de.de', 115 -meta=>{'keywords' => 'Perl-Stammtisch', 116 'copyright'=>'copyright 1999 Dr. Thomas Wieland'} 117 )."\n"; 118 print center(table({-border => 0, 119 -width => '95%'}, 120 TR(td(img{-src => "$icons/$title_gif", 121 -alt => 'Linkseite Logo'}), 122 td(h4('Links verwalten')), 123 td(a({-href=> $homeurl}, 124 img{-src => "$icons/$homepage_gif", 125 -alt => 'Zur Homepage', 126 -border => 0} 127 ) 128 ) 129 ) 130 ) 131 ),hr,"\n"; 132 } 133 134 135 ############################################### 136 sub formular { 137 ############################################### 138 my $name = param('name'); 139 my $nr = param('nr'); 140 my $url =param('url'); 141 my $grpid = param('grpid'); 142 my @katnames = sort(keys %katnames); 143 print start_form(-method => $method), 144 table({-border => 0}, 145 TR(td(["Name:", 146 textfield(-name => 'name', -value => "$name", -size => 40)])), 147 TR(td(["URL:", 148 textfield(-name => 'url', -value => "$url", -size => 40)])), 149 ), 150 hidden(-name => 'nr', -value => "$nr"), 151 scrolling_list(-name => 'grpid', 152 -values => \@katnames, 153 -labels => \%katnames, 154 -size => 1), 155 table({-border => 0}, 156 TR(td([submit (-name => 'insert', 157 -value => 'Eintragen'), 158 submit (-name => 'edit', 159 -value => 'Ändern'), 160 submit (-name => 'delete', 161 -value => 'Löschen')] 162 ) 163 ) 164 ), 165 end_form(),hr; 166 167 } 168 169 ############################################### 170 sub kat { 171 ############################################### 172 # Zeile mit Links zu den einzelnen Kategorien erzeugen 173 $sql = qq[ SELECT * FROM $Tab_Link_Kat ORDER BY gruppe ]; 174 $sth = $dbh->prepare($sql); 175 $sth->execute(); 176 177 print "<center>|"; 178 while ($row = $sth->fetchrow_arrayref) { 179 print b(" "), 180 a({href => "#".$row->[1]},$row->[1]), 181 b(" |"); 182 $kat{"$row->[1]"} = $row->[0]; 183 $katnames{"$row->[0]"} = $row->[1]; 184 } 185 print b(" "),a({href => $kadminurl}, 'Kategorien verwalten'),b(" |"); 186 print b(" "),a({href => $linkurl}, 'Links anzeigen'),b(" |"); 187 print "</center>",hr; 188 $sth->finish; 189 } 190 191 ############################################### 192 sub links { 193 ############################################### 194 my $kategorie = undef; 195 foreach $kategorie (sort(keys %kat)) { 196 # Überschrift und Anker 197 print "<blockquote>\n",a({name => $kategorie}), h3($kategorie),"\n"; 198 # passende Einträge holen und ausgeben 199 $sql = qq[ SELECT url, name, stamp, linkid, grpid FROM $Tab_Links 200 WHERE grpid = '$kat{$kategorie}' ORDER by name]; 201 $sth = $dbh->prepare($sql); 202 $sth->execute(); 203 while ($row = $sth->fetchrow_hashref) { 204 print a({href => url()."?url=".uri_escape($row->{'url'}). 205 "&name=".uri_escape($row->{'name'}). 206 "&nr=".uri_escape($row->{'linkid'}). 207 "&grpid=".uri_escape($row->{'grpid'})}, 208 $row->{'name'})," ",$row->{'stamp'},br,"\n"; 209 } 210 print "</blockquote>\n",hr,"\n"; 211 } 212 $sth->finish; 213 }
Zurück zum Anfang dieses Projekts.