Logo

This is www.cargal.org, home to all who seek knowledge and discussion.
Community, Arts, Research, Gnu, Answers and Liberty

CARGAL?
CARGAL is a project to promote free webculture and to provide a plattform for everyone to express him/herself.
Please read the about
//
CARGAL ist ein Projekt um die freie Netzkultur zu fördern und jedem/r Interessierten eine Plattform zu bieten, sich frei zu entfalten.
Bitte lies vorher die Info

CONTACT
If you want to get in direct contact with us use a jabberclient and go to the conference "cargal" on "jabber.cargal.org"
more infos

Wenn du mit uns in direkten Kontakt treten willst benutze einen Jabberclient und gehe zur Konferenz namens "cargal" auf "jabber.cargal.org"
mehr Infos

Projekte
Wo werden Leute, ob CARGALvereinsmitglied oder nicht, gebraucht,
welches Thema würde sich über Aufmerksamkeit freuen?

TOPICS
·Anleitung (126)
·Arts (162)
 ·Buch (14)
 ·Film (74)
  ·Kino (32)
  ·TV (6)
  ·DVD (13)
 ·Musik (41)
  ·Ogg (5)
 ·Küche (12)
  ·Bars
  ·Restaurants (5)
·Cargal (84)
 ·Verein_CARGAL (28)
·Computer (475)
 ·Apple (4)
 ·Betriebssysteme (119)
  ·FreeBSD
  ·GNU (94)
   ·GPL (1)
   ·Hurd
   ·Linux (92)
    ·Debian (33)
     ·Debianhelp (2)
     ·Debianpaket
    ·Gentoo (8)
    ·Redhat (3)
    ·SuSE (2)
 ·Hardware (23)
  ·Prozessor
   ·AMD
   ·Intel
 ·Internet (156)
  ·Apache (1)
  ·mITtendrin (85)
 ·Laptop (2)
 ·Programmiersprachen (51)
  ·Java (1)
  ·Perl (9)
  ·PHP (7)
 ·Software (78)
  ·Encryption (11)
   ·GnuPG (3)
  ·Gnome (3)
  ·Gnome2 (4)
  ·Instantmessaging (4)
  ·KDE
  ·Mozilla (1)
  ·Openoffice (3)
  ·X (4)
 ·Usenet
 ·Security (9)
·Disobey (69)
·Events (47)
·News (40)
·Personal (263)
·Science (15)
·Smartphones (2)
 ·Android (1)
·Spiele (13)
·Visions (124)
 ·Politik (56)
 ·Soziales (48)

FreeSoftware
Length of Applause Not Tied To Quality of Presentation
Why Your Sysadmin Hates You
Red Hat weiter mit guten Quartalszahlen
GNU MediaGoblin erscheint in Version 0.4.0
France gives Google three month DATA PRIVACY DEADLINE


PolitikSoziales
Energiedichte ist nicht alles
Ami Go Home in Peace
Antarktis: Ozeane nagen am Eis
Nazis bei der Stasi und rechtsterroristische Doppelagenten
Kein Neuland


Who's new
steph02
sel
tobik1000
mm2knet
Schneemann

Browse archives
< June 2013 >
SMTWTFS
  1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30  


Workpages of CARGAL
Skriptsprachen, ein Vergleich
- Aufgabe 1 - Gästebuch

Perl
Last updated by m3 on Thursday, 26/12/2002 - 00:10

Hier meine Version mit Perl.

Benutzt werden ein paar nette Module, um die URLs und Mail-Adressen zu checken, ansonsten nix aufregendes.
Ich hoffe, ich hab ausreichend dokumentiert.
  1 #!/usr/bin/perl -w
2
3 # Copyright (c) 2002 by Martin 'm3'Leyrer
4 #
5 #
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19
20
21
use strict; # We want more Errors! ;)
22
use DBI; # Database Interface
23
use CGI; # CGI-Tools
24
use CGI::Carp qw(fatalsToBrowser); # Fatal error messages are now sent to browser
25
use Time::Piece::MySQL; # Convert Unix-Timestamps to MySQL format and vice versa
26
require URI::Find::Schemeless; # Validate a URL
27
use Mail::RFC822::Address qw(valid); # Validates email addresses against the grammar described in RFC 822 using regular expressions.
28
29
30
31 # create new CGI object
32
use CGI qw/:cgi/;
33 my $query = new CGI;
34 print $query->header; # print HTTP headers
35
36 # read possible POST-values into array
37
my @fields = qw { name mail web comment };
38 my @para;
39 foreach (@fields) {
40 push(@para, $query->param($_));
41 }
42
43 # print HTML-Form
44
print << '__UND_AUS__';
45 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
46 <html>
47 <head>
48 <title>Projekt5: GB</title>
49 </head>
50
51 <body>
52 <form name="gbform" method="post" action="guestbook.pl">
53 <table width="40%" border="0" cellspacing="0" cellpadding="0">
54 <tr>
55 <td>Name</td>
56 <td><input type="text" name="name"></td>
57 </tr>
58 <tr>
59 <td>eMail</td>
60 <td><input type="text" name="mail"></td>
61 </tr>
62 <tr>
63 <td>web</td>
64 <td><input type="text" name="web"></td>
65 </tr>
66 <tr>
67 <td>comment</td>
68 <td><textarea name="comment"></textarea></td>
69 </tr>
70 <tr>
71 <td>&nbsp;</td>
72 <td><input type="submit" name="submit" value="eintragen"></td>
73 </tr>
74 </table>
75 </form>
76 __UND_AUS__
77
78 # Connect to DB
79
my $dbh = DBI->connect("DBI:mysql:cargal_guestbook", 'cargal', 'THINK! DISOBEY! CREATE!', { RaiseError => 1, AutoCommit => 1 } ) or die "Fehler $DBI::errstr";
80
81 # put posted data (if any) into db
82
if (request_method() eq "POST") {
83 my $erg = add_data(@para);
84 if( $erg > 0) {
85 die "Error with writing Parameter '$fields[$erg]'. Value: '$para[$erg]'<p>n";
86 }
87 }
88
89 # read & print old entries
90
my $sth = $dbh->prepare("SELECT * FROM guestbook ORDER BY timestamp DESC");
91 $sth->execute();
92 while ( my @row = $sth->fetchrow_array ) {
93 print "$row[0] (<a href="mailto:$row[1]">$row[1]</a> <b> || </b>";
94 print "<a href="$row[2]">$row[2]</a>) schrieb am ";
95 print mysqltime2human($row[4]) . ":<br>n";
96 print "<pre>$row[3]</pre>n<br><br>n";
97 }
98
99 print "</body>n</html>n";
100
101 # close connection to db
102
$dbh->disconnect;
103
104
105 # verify data and insert it into the db
106
sub add_data {
107 my $para = shift @_;
108
109 $para[0] = $para[0];
110 return(1) if($para[0] eq '');
111 $para[1] = check_email($para[1]);
112 return(2) if($para[1] eq '');
113 $para[2] = check_url($para[2]);
114 return(3) if($para[2] eq '');
115 $para[3] = $para[3];
116 return(4) if($para[3] eq '');
117
118 # Prepare Insert
119
my $sth = $dbh->prepare('INSERT INTO guestbook (name, email, web, eintrag, timestamp) VALUES (?,?,?,?,?)');
120
121 # Timestamp generieren
122
my $time = localtime;
123 push(@$para, $time->mysql_datetime);
124
125 # Execute Insert
126
my $rv = $sth->execute(@$para) or die $sth->errstr;
127 if ($rv < 0) {
128 die $sth->errstr;
129 }
130 return(0);
131 }
132
133 # Convert MySQL Timestamp into human redable format
134
sub mysqltime2human {
135 my $m = shift @_;
136 my $t = Time::Piece->from_mysql_datetime( $m );
137 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
138 my $s = sprintf( "%2.2d.%2.2d.%4.4d um %2.2d:%2.2d Uhr", $mday+1, $mon, 1900+$year, $hour, $min);
139 return($s);
140 }
141
142 sub check_url {
143 my $url = shift @_;
144 my $uri = '';
145
146 my $finder = URI::Find::Schemeless->new(
147 sub {
148 $uri = shift @_;
149 return $uri;
150 });
151 if ( $finder->find($url) ) {
152 return($uri);
153 } else {
154 return('');
155 }
156 }
157
158 sub check_email {
159 my $mail = shift @_;
160 if (valid($mail)) {
161 return($mail);
162 } else {
163 return('');
164 }
165 }


    previousindexnext
    MySQL BasisupPHP


    Control panel

    Comment viewing options:

    Select your prefered way to display the comments and click 'Update settings' to active your changes.


  • It's a kind of magic... ;-) by citizen428@cargal.org
  • Navigation

    Log in
    Username:

    Password:

    Remember me

    » New password

    GnuPG
    Key-Suchstring:



    » add to Sidebar

    Latest poll: Wenn eins der
    folgenden Smartphones, dann....
    PALM PRE FTW!
    Motorola Milestone
    Nokia N900
    Sony Xperia X10 Rachael
    BOB hat ein Dynatac 8000 , das reicht mir auch!