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.
