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> </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 }
Die Meldung finden Sie im Original unter http://www.cargal.org/drupal/node.php?id=105
Tagged as: Wissen_ist_Macht | Author: Martin Leyrer
[Mittwoch, 20021225, 23:10 | permanent link | 0 Kommentar(e)
Comments are closed for this story.