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 }


Die Meldung finden Sie im Original unter http://www.cargal.org/drupal/node.php?id=105

Tagged as: | Author:
[Mittwoch, 20021225, 23:10 | permanent link | 0 Kommentar(e)

Comments are closed for this story.


Disclaimer

„Leyrers Online Pamphlet“ ist die persönliche Website von mir, Martin Leyrer. Die hier veröffentlichten Beiträge spiegeln meine Ideen, Interessen, meinen Humor und fallweise auch mein Leben wider.
The postings on this site are my own and do not represent the positions, strategies or opinions of any former, current or future employer of mine.

Me, Elsewhere

Tag Cloud

2007, 2blog, 2do, 2read, a-trust, a.trust, a1, accessability, acta, advent, age, ai, amazon, ankündigung, apache, apple, audio, austria, backup, barcamp, basteln, bba, big brother awards, birthday, blog, blogging, book, books, browser, Browser_-_Firefox, bruce sterling, buch, bürgerkarte, cars, cartoon, ccc, cfp, christmas, cloud, coding, collection, command line, commandline, computer, computing, concert, conference, copyright, covid19, css, database, date, datenschutz, debian, delicious, demokratie, design, desktop, deutsch, deutschland, dev, developer, development, devops, digitalks, dilbert, disobay, dna, dns, Doctor Who, documentation, domino, Domino, Douglas Adams, download, downloads, drm, dsk, dvd, e-card, e-government, e-mail, e-voting, E71, education, Ein_Tag_im_Leben, elga, email, encryption, essen, eu, EU, event, events, exchange, Extensions, fail, fedora, feedback, film, firefox, flash, flightexpress, food, foto, fsfe, fun, future, games, gaming, geek, geld, git, gleichberechtigung, google, graz, grüne, grüninnen, hack, hacker, handtuch, handy, hardware, HHGTTG, history, how-to, howto, hp, html, humor, IBM, ibm, ical, iCalendar, image, innovation, intel, internet, internet explorer, iot, iphone, ipod, isp, it, IT, itfails, itfailsAT, itfailsDE, java, javascript, job, jobmarket, journalismus, keyboard, knowledge, konzert, language, laptop, law, lego, lenovo, life, links, Linux, linux, linuxwochen, linuxwochenende, live, living, lol, london, lost+found, Lotus, lotus, lotus notes, Lotus Notes, lotusnotes, LotusNotes, Lotusphere, lotusphere, Lotusphere2006, lotusphere2007, lotusphere2008, Lotusphere2008, lustig, m3_bei_der_Arbeit, mac, mail, marketing, mathematik, media, medien, metalab, Microsoft, microsoft, mITtendrin, mobile, mood, motivation, movie, mp3, multimedia, music, musik, männer, nasa, nerd, netwatcher, network, netzpolitik, news, nokia, Notes, notes, Notes+Domino, office, online, OOXML, open source, openoffice, opensource, orf, orlando, os, outlook, patents, pc, pdf, performance, perl, personal, php, picture, pictures, podcast, politics, politik, pr, press, presse, privacy, privatsphäre, productivity, programming, protest, public speaking, qtalk, quintessenz, quote, quotes, radio, rant, recherche, recht, release, review, rezension, rip, rss, science, search, security, server, settings, sf, shaarli, Show-n-tell thursday, sicherheit, silverlight, smtp, SnTT, social media, software, sony, sound, space, spam, sprache, spö, ssh, ssl, standards, storage, story, stupid, summerspecial, sun, surveillance, sysadmin, talk, talks, technology, The Hitchhikers Guide to the Galaxy, theme, think, thinkpad, thunderbird, tip, tipp, tools, topgear, torrent, towel, Towel Day, TowelDay, travel, truth, tv, twitter, ubuntu, ui, uk, unix, update, usa, usb, vds, video, videoüberwachung, vienna, Vim, vim, vintage, vista, vorratsdatenspeicherung, vortrag, wahl, wcm, web, web 2.0, web2.0, web20, Web20, webdesign, werbung, wien, wiener linien, wikileaks, windows, windows 7, wired, wishlist, wissen, Wissen_ist_Macht, wlan, work, workshops, wow, writing, wtf, wunschzettel, Wunschzettel, www, xbox, xml, xp, zensur, zukunft, zune, österreich, övp, übersetzung, überwachung

AFK Readinglist