1 Introduction to Perl
 1.1Tutorials    
 1.2Logos    
 1.3Frequently Asked Questions & Answers    
 1.4Perl Success Stories    
2 Documentation
 2.1Core Documentation    
 2.2Text Manipulations    
  2.2.1    Hashes
 2.3Regular Expressions    
  2.3.1    Regex Recipes
 2.4Files    
  2.4.1    File Access
  2.4.2    How to Rewind the STDIN?
 2.5Databases    
  2.5.1    DBI (Generic Code)
  2.5.2    DBI Auto Coder
 2.6Data Encoding    
  2.6.1    UTF to ISO
  2.6.2    ISO to UTF
 2.7CGI Programming    
 2.8Ajax    
 2.9Cryptography    
 2.10Networking with Perl    
  2.10.1    LWP
 2.11Graphics & Charts    
  2.11.1    Graphics & Charts - Code
 2.12Related Books    
3 Data Encoding & Conversion
 3.1Web Encoding & Decoding    
  3.1.1    Generic Web Encoding
 3.2Character Encoding    
 3.3IDN Punycode    
4 Date & Time in Perl
 4.1Date & Time Calculations (Date::Manip)    
 4.2Format Time    
 4.3Calculate Easter Day    
 4.4Calculate Weekday    
 4.5Related Date & Time Links    
5 XML with Perl
 5.1RSS 2.0    
 5.2XML RPC    
  5.2.1    XML::Parser
 5.3SOAP    
  5.3.1    SOAP Error Handling
  5.3.2    SOAP Basic Authorization
  5.3.3    SOAP Array
  5.3.4    Google SOAP
  5.3.5    SOAP Examples
 5.4eBay API    
  5.4.1    Example: get Ebay Time
6 Perl for Sysad's
 6.1telnet    
 6.2whois Interface    
 6.3Perl Socket Server    
 6.4HTML-ify    
  6.4.1    Automate HTML-ify
 6.5sslcsr.pl    
 6.6getpid Process id    
 6.7LDAP    
 6.8Delete old files (cleanup.pl)    
 6.9Delete accident files    
 6.10wikisync.pl    
7 Newsgroups & Mailinglists
8 mod_perl
 8.1Apache Handler    
 8.2Customizing the Fixup Phase (Apache::HttpEquiv)    
9 Advanced Features in Perl
 9.1Performance    
 9.2Monitored Variables    
 9.3Suppress warnings from external modules    
 9.4Using C++ from perl with Inline    
10 GUI Programming
11 Perl-based Software
 11.1CPAN    
 11.2Perl Forums    
12 Further Links
13 About
 13.1Contact    
 13.2Guestbook    
 13.3What's new?    
 13.4My Perl Modules    
  13.4.1    Website.pm
 13.5Licencing    

1 Introduction to Perl

1.1   Tutorials
1.2   Logos
1.3   Frequently Asked Questions & Answers
1.4   Perl Success Stories

Perl is an interpreted language optimized for scanning arbitrary text files, extracting information from those text files, and printing reports based on that information.

Llamas

It's also a good language for many system management tasks. The language is intended to be practical (easy to use, efficient, complete) rather than beautiful (tiny, elegant, minimal). It combines (in the author's opinion, anyway) some of the best features of C, sed, awk, and sh, so people familiar with those languages should have little difficulty with it (Language historians will also note some vestiges of csh, Pascal, and even BASIC-PLUS).

Expression syntax corresponds quite closely to C expression syntax. Unlike most Unix utilities, perl does not arbitrarily limit the size of your data -- if you've got the memory, perl can slurp in your whole file as a single string.

Recursion is of unlimited depth. And the hash tables used by associative arrays grow as necessary to prevent degraded performance. Perl uses sophisticated pattern matching techniques to scan large amounts of data very quickly.

Although optimized for scanning text, perl can also deal with binary data, and can make dbm files look like associative arrays (where dbm is available). Setuid perl scripts are safer than C programs through a dataflow tracing mechanism which prevents many stupid security holes. If you have a problem that would ordinarily use sed or awk or sh, but it exceeds their capabilities or must run a little faster, and you don't want to write the silly thing in C, then perl may be for you. There are also translators to turn your sed and awk scripts into perl scripts.

OK, enough hype.

(Unknown)

Deutsche Kurzfassung



Most related Links:

1.1 Tutorials

See also the core documentation of Perl.


Available Tutorials

1.2 Logos


[ Handy Logos (Legacy) ]

1.3 Frequently Asked Questions & Answers

1.4 Perl Success Stories

perl.oreilly.com/news/success_stories.html↑

2 Documentation

Overview

2.1   Core Documentation
2.2   Text Manipulations
 2.2.1  Hashes
2.3   Regular Expressions
 2.3.1  Regex Recipes
2.4   Files
 2.4.1  File Access
 2.4.2  How to Rewind the STDIN?
2.5   Databases
 2.5.1  DBI (Generic Code)
 2.5.2  DBI Auto Coder
2.6   Data Encoding
 2.6.1  UTF to ISO
 2.6.2  ISO to UTF
2.7   CGI Programming
2.8   Ajax
2.9   Cryptography
2.10   Networking with Perl
 2.10.1  LWP
2.11   Graphics & Charts
 2.11.1  Graphics & Charts - Code
2.12   Related Books
2.13   Etc.
 2.13.1  UTF-8, RNUTF-8TOP

2.1 Core Documentation

Overview

2.2 Text Manipulations

[ Go ]

2.2.1 Hashes

Transform a key / value string to a hash with map and split. 

#!/usr/bin/perl -w
use strict;

my $string = q~DefaultUserDir=/filer/0
Integer DomainUsers=5
Integer TotalMessages=50
Integer AverageSize=19
Integer DomainDiskUsage=966
~;

my @array = split /\n/, $string;
my %hash = map { split /\=/ } @array;

foreach (keys %hash) {
        print "=====>  '$_' = \t'$hash{$_}'\n";
}

Output:

=====>  'Integer AverageSize' =         '19'
=====>  'DefaultUserDir' =      '/filer/0'
=====>  'Integer DomainDiskUsage' =     '966'
=====>  'Integer DomainUsers' =         '5'
=====>  'Integer TotalMessages' =       '50'

2.3 Regular Expressions

Common needed regular expressions

This page describes the syntax of regular expressions in Perl. For a description of how to use regular expressions in matching operations, plus various examples of the same, see discussions of m//, s///, qr// and ?? in perlop/"Regexp Quote-Like Operators".

Matching operations can have various modifiers. Modifiers that relate to the interpretation of the regular expression inside are listed below. Modifiers that alter the way a regular expression is used by Perl are detailed in perlop/"Regexp Quote-Like Operators" and perlop/"Gory details of parsing quoted constructs".

i

Do case-insensitive pattern matching.

If use locale is in effect, the case map is taken from the current locale. See perllocale.

m
Treat string as multiple lines. That is, change "^" and "$" from matching the start or end of the string to matching the start or end of any line anywhere within the string.
s

Treat string as single line. That is, change "." to match any character whatsoever, even a newline, which normally it would not match.

The /s and /m modifiers both override the $* setting. That is, no matter what $* contains, /s without /m will force "^" to match only at the beginning of the string and "$" to match only at the end (or just before a newline at the end) of the string. Together, as /ms, they let the "." match any character whatsoever, while yet allowing "^" and "$" to match, respectively, just after and just before newlines within the string.

x
Extend your pattern's legibility by permitting whitespace and comments.

These are usually written as "the /x modifier", even though the delimiter in question might not really be a slash. Any of these modifiers may also be embedded within the regular expression itself using the (?...) construct. See below.

The /x modifier itself needs a little more explanation. It tells the regular expression parser to ignore whitespace that is neither backslashed nor within a character class. You can use this to break up your regular expression into (slightly) more readable parts. The # character is also treated as a metacharacter introducing a comment, just as in ordinary Perl code. This also means that if you want real whitespace or # characters in the pattern (outside a character class, where they are unaffected by /x), that you'll either have to escape them or encode them using octal or hex escapes. Taken together, these features go a long way towards making Perl's regular expressions more readable. Note that you have to be careful not to include the pattern delimiter in the comment--perl has no way of knowing you did not intend to close the pattern early. See the C-comment deletion code in perlop.

Regular Expressions toc

The patterns used in Perl pattern matching derive from supplied in the Version 8 regex routines. (The routines are derived (distantly) from Henry Spencer's freely redistributable reimplementation of the V8 routines.) See Version 8 Regular Expressions for details.

In particular the following metacharacters have their standard egrep-ish meanings:

    \	Quote the next metacharacter
    ^	Match the beginning of the line
    .	Match any character (except newline)
    $	Match the end of the line (or before newline at the end)
    |	Alternation
    ()	Grouping
    []	Character class

By default, the "^" character is guaranteed to match only the beginning of the string, the "$" character only the end (or before the newline at the end), and Perl does certain optimizations with the assumption that the string contains only one line. Embedded newlines will not be matched by "^" or "$". You may, however, wish to treat a string as a multi-line buffer, such that the "^" will match after any newline within the string, and "$" will match before any newline. At the cost of a little more overhead, you can do this by using the /m modifier on the pattern match operator. (Older programs did this by setting $*, but this practice is now deprecated.)

To simplify multi-line substitutions, the "." character never matches a newline unless you use the /s modifier, which in effect tells Perl to pretend the string is a single line--even if it isn't. The /s modifier also overrides the setting of $*, in case you have some (badly behaved) older code that sets it in another module.

The following standard quantifiers are recognized:

    *	   Match 0 or more times
    +	   Match 1 or more times
    ?	   Match 1 or 0 times
    {n}    Match exactly n times
    {n,}   Match at least n times
    {n,m}  Match at least n but not more than m times

(If a curly bracket occurs in any other context, it is treated as a regular character.) The "*" modifier is equivalent to {0,}, the "+" modifier to {1,}, and the "?" modifier to {0,1}. n and m are limited to integral values less than a preset limit defined when perl is built. This is usually 32766 on the most common platforms. The actual limit can be seen in the error message generated by code such as this:

    $_ **= $_ , / {$_} / for 2 .. 42;

By default, a quantified subpattern is "greedy", that is, it will match as many times as possible (given a particular starting location) while still allowing the rest of the pattern to match. If you want it to match the minimum number of times possible, follow the quantifier with a "?". Note that the meanings don't change, just the "greediness":

    *?	   Match 0 or more times
    +?	   Match 1 or more times
    ??	   Match 0 or 1 time
    {n}?   Match exactly n times
    {n,}?  Match at least n times
    {n,m}? Match at least n but not more than m times

Because patterns are processed as double quoted strings, the following also work:

    \t		tab                   (HT, TAB)
    \n		newline               (LF, NL)
    \r		return                (CR)
    \f		form feed             (FF)
    \a		alarm (bell)          (BEL)
    \e		escape (think troff)  (ESC)
    \033	octal char (think of a PDP-11)
    \x1B	hex char
    \x{263a}	wide hex char         (Unicode SMILEY)
    \c[		control char
    \N{name}	named char
    \l		lowercase next char (think vi)
    \u		uppercase next char (think vi)
    \L		lowercase till \E (think vi)
    \U		uppercase till \E (think vi)
    \E		end case modification (think vi)
    \Q		quote (disable) pattern metacharacters till \E


Common needed regular expressions

  1. Remove leading and trailing spaces (trim a string)
    Actually, it's a work-around, but it works properly and quickly ;-)
    $trimmed_string = ' Firstname Middle. Lastname ';
    $trimmed_string = join " ", grep { $_ } split / /, $trimmed_string;
    Perl pre-parsed version would be:
    $trimmed_string = join(' ', grep({$_;} split(/ /, $trimmed_string, 0)));
  2. Remove HTML tags
    $Msg =~ s/<[^>]+>//g;
  3. Remove dot dirs out of directory listing 
    opendir(D, '/var/www/') or print $!;
while (my $f = readdir(D)) {
        next if $f =~ /^\.+$/;
        print "$f\n";
}
closedir(D);
  4. Simple check for valid E-Mail address
    /^[A-Z0-9\-_\.]+\@[A-Z0-9\-\.]+\.[A-Z]{2,}$/i
  5. Simple check for a valid 2nd level domain
    /^[a-z0-9\-]+\.[a-z]{2,5}$/i
    Better check for domains:
    @answer = split /\n/, `whois -h whois.nic.ch $domain` if $domain =~ /\.ch$/i;
    @answer = split /\n/, `whois $domain` if $domain !~ /\.ch$/i;
  6. Extract a second-level domain e-mail address from a text line
    email or abuse inquiries contact postmaster@mail.com. law enforcement issues contact 646-223-1227
    after: postmaster@mail.com
    $line =~ s/.*\s([a-z0-9\-_\.]+\@[a-z0-9\-\.]+\.?[a-z]{2,}).*/$1/;
  7. Check if the file has a suffix ".htm" or ".html"
    /.+\.html?$/i;
  8. Check, if ending of a string meets a list of suffixes 
    if ($file =~ /(\.jpg)|(\.gif)$/i) {
        print "Grafik\n";
}

2.3.1 Regex Recipes

Regex Recipe

You want to get back the complete word that has matched your search string.

e.g. fri → frische, as → asdf, fi → Fische, mei → meistens ...

#!/usr/bin/perl -w
use strict;

my $str = 'Fischer Fritz fischt meistens frische asdf oder foo Fische';

my $IN = $ARGV[0] || '';

if ($str =~ /.*\b(.*$IN.*?)\b.*/i) {
        print "$1\n";
}


See also:

2.4 Files



2.4.1 File Access

open FILEHANDLE,MODE,LIST
open FILEHANDLE,EXPR
open FILEHANDLE

[ Rewind the STDIN file handle ]

If MODE is '<' or nothing, the file is opened for input. If MODE is '>', the file is truncated and opened for output, being created if necessary. If MODE is '>>', the file is opened for appending, again being created if necessary. You can put a '+' in front of the '>' or '<' to indicate that you want both read and write access to the file; thus '+<' is almost always preferred for read/write updates--the '+>' mode would clobber the file first. You can't usually use either read-write mode for updating textfiles, since they have variable length records.

See also

File::chmod
File::chmod is a utility that allows you to bypass system calls or bit processing of a file's permissions. It overloads the chmod() function with its own that gets an octal mode, a symbolic mode, or an %22ls%22 mode. If you wish not to overload chmod(), you can export symchmod() and lschmod(), which take, respectively, a symbolic mode and an %22ls%22 mode.

File::PathConvert
File::PathConvert provides conversions from absolute to relative and back again for URLs, Unix, DOS, MacOS, and VMS. [POD]

File::Slurp
File::Slurp provides single call read and write file routines and the ability to read directories.

File::Sort
Written primarily for MacPerl users who do not have sort(1) and because of memory limitations cannot sort files in memory, but works on all Perls.

File::Spec
This module is designed to support operations commonly performed on file specifications (usually called %22file names%22, but not to be confused with the contents of a file, or Perl's file handles), such as concatenating several directory and file names into a single path, or determining whether a path is rooted.

File::Sync
File::Sync provides Perl interfaces to the Unix sync(2) and POSIX.1b fsync(2) system calls. The fsync() call is needed for putting messages into qmail maildirs, and sync() is included for completeness.

File::Tail
The File::Tail package is designed for reading files which are continously appended to (the name comes from the tail -f directive). Usualy such files are logfiles of some description. The package tries not to busy wait on the file, dynamicaly calcultaing how long it should wait before it pays to try reading the file again. Currently this package requires Time::HiRes, because it often needs to sleep for less than one second.

File::Temp
File::Temp can be used to create and open temporary files in a safe way. The tempfile() function can be used to return the name and the open filehandle of a temporary file. The tempdir() function can be used to create a temporary directory.

2.4.2 How to Rewind the STDIN?

In special cases it can be needed to re-read from the STDIN file handle, e.g. in a mail or Listserver processing with Perl. There might be even more sophisticated solutions on this problem but the following one will work. If you had a better recipe please let me know.

How to test this example:

ls -l /tmp | script.pl

Recipe

#!/usr/bin/perl -w
use strict;
$| = 1;

local *FH;

*FH = &stdin(); # Now you have a rewind-able file handle to your STDIN data

# -- first run
while(<FH>) {
        print "[R1]=> $_";
}

seek(FH, 0, 0);

# -- second run
while(<FH>) {
        print "[R2]=> $_";
}

sub stdin () {
        my $tempfile = time() . '_' . int(rand(1000000));
        open(TEMP, "+>/tmp/temp_$tempfile") or print STDERR $!;
        local $/ = undef;
        print TEMP <STDIN>;
        seek(TEMP, 0, 0);
        \*TEMP;
}

2.5 Databases

Most related

2.5.1 DBI (Generic Code)

Search → Dbi/


dbi_generic.pl

#!/usr/bin/perl -w
use strict;

use DBI;

#####  PROTOTYPING
sub Debug($);

#####  GLOBAL
my $DEBUG = 0; # ZZ
require "../eshop_generic.ini";
my %DATABASE = &DATABASE();

my $LANG = 'de';
my $ID = 6010;

my $G_RC = 0;
my $dbh = DBI->connect(
	"dbi:Pg:dbname=$DATABASE{'db'}", $DATABASE{'user'}, $DATABASE{'pass'},
	{ PrintError => 0,
          AutoCommit => 1
        }
) or $G_RC++;
print $DBI::errstr if $G_RC;

&main();

#########################################
sub main() {
#########################################
	my @fields = qw(items.name items_attributes.attr_id items_attributes_names.name
			items_attributes.val);

	my $data_ref = &get_item_data(
		stmt => 'SELECT ' . join(', ', @fields) .
			' FROM items,items_attributes,items_attributes_names ' .
			'WHERE items.id=items_attributes.item_id AND ' .
			'items_attributes.attr_id=items_attributes_names.id ' .
			'AND is_option=0 AND items.lang=\'' . $LANG .
			"' AND items_attributes_names.lang='$LANG' AND " .
			'items_attributes.lang IN (items_attributes_names.lang, \'_meta\') AND ' .
			'items.id=' . $ID . ' ORDER BY attr_id' ,

		fields => \@fields
	);

	###################################
	# -- Process db records
	###################################
	foreach my $hash_ref (@{$data_ref->{'result_arr'}}) {
		if ($DEBUG) {
			Debug "$_ = \"" . $hash_ref->{$_} . '"' foreach keys %{$hash_ref}; print "\n";
		}
		print '- ', $hash_ref->{'items_attributes_names.name'}, ': ',
				 $hash_ref->{'items_attributes.val'}, "\n";
	}

	###################################
	# -- Get a single database row
	###################################
	@fields = qw(has_parent);
	$data_ref = &get_item_data(
		stmt => 'SELECT ' . join(', ', @fields) . " FROM items WHERE id=$ID AND lang='$LANG'",
		fields => \@fields
	);
	if (@{$data_ref->{'result_arr'}}) {
		my $par_id = (\%{@{$data_ref->{'result_arr'}}[0]})->{'has_parent'};
		print "par_id = $par_id\n";
	}
}


#########################################
sub get_item_data(%) {
#########################################
        my %args = @_;

        my %hash = ();

        Debug $args{'stmt'} if $DEBUG;

        my $sth = $dbh->prepare($args{'stmt'}) or Debug "$DBI::errstr $args{'stmt'}";
           $sth->execute() or Debug "$DBI::errstr $args{'stmt'}";

        my %results = ();
        $sth->bind_columns(map { \$results{$_} } @{$args{'fields'}});

        my @result_arr = ();
        while($sth->fetch()) {
                my %p_results = %results;
                push(@result_arr, \%p_results);
        }

        $hash{'result_arr'} = \@result_arr;
        \%hash;
}

sub Debug($) { print "$_[0]\n"; }

__END__

[ Download dbi_generic.pl ]

eshop_generic.ini

# -- Save as: "eshop_generic.ini"

sub DATABASE {
        (
        db     => 'eshop_generic',
        driver => 'Pg',
        user   => 'apache',
        pass   => '',
        host   => 'localhost'
        )
}

1;

2.5.2 DBI Auto Coder

X X X

[ Create PostgreSQL Table Online Tool ]

Database Name
DB Table Name
db login (username:password) self compiled Apache: usually nobody
DB Driver Pg = PostgreSQL / mysql = MySQL
Columns, separated by commas


Filename of database
configuration file


2.6 Data Encoding

Character Encoding and Safe Queries

This page has to be moved.



2.6.1 UTF to ISO

Download → files/toiso pl.txt 
#!/usr/bin/perl -w
$| = 1;
use strict;

use Unicode::String qw(latin1 utf8);

my $foo = $ARGV[0] || '';

$foo = &toISO($foo);

print "-> $ARGV[0]\n";
print "<- $foo\n";

sub toISO($) {
        my $text = $_[0];
        # if this host was UTF-8 encoded:
        my $text_iso  = (utf8($text))->latin1;
        my $text_utf8 = (latin1($text_iso))->utf8; # reverse check

        if ($text ne $text_utf8) {
                # print STDERR "Unequal reverse check! It seems your input data \"$text\" is ",
                #        "ISO encoded already, so you don't need the latin1 encoding stuff here!\n";
                # I'm going to fix this
                $text_iso = $text;
        }
        $text_iso;
}


See also:
To utf
Web encoding decoding

2.6.2 ISO to UTF

Download → files/toutf pl.txt 
#!/usr/bin/perl -w
$| = 1;
use strict;

use Unicode::String qw(latin1 utf8);

my $foo = $ARGV[0] || '';

if (&isISO($foo)) {
	print "Is ISO!\n";
	$foo = (latin1($foo))->utf8;
}
else {
	print "Is UTF\n";
}

print "-> $ARGV[0]\n";
print "<- $foo\n";

sub isISO ($) {
	my $text = $_[0];
	my $text_iso  = (utf8($text))->latin1;
	my $text_utf8 = (latin1($text_iso))->utf8; # reverse check
	return $text eq $text_utf8 ? 0 : 1;
}


See also:
Toiso
Web encoding decoding

2.7 CGI Programming

1 CGI
 1.1CGI::Lite    
 1.2Play with Cookies    
  1.2.1    How to cgi post arguments and Cookies?
  1.2.2    cookie_jar / Keep Cookies with LWP
 1.3Manually Parsing CGI key pairs    
 1.4CGI to mod_perl    
2 LWP
 2.1CGI GET method    
 2.2CGI POST method    
 2.3https XML POST with LWP    
 2.4Access to protected URIs    
3 Etc
 3.1Post to Newsgroup    
 3.2HTTP Header    
 3.3check for the existance of an URI (LWP)    
 3.4Referer / Range    
4 Related Links
5 Alphabetical Index


See also:
search.cpan.org/modlist/World_Wide_Web/CGI↑

2.8 Ajax

I have prepared another example on infocopter.ch/ajax.html

Prerequisites

cpan> install CGI::Ajax
Download files/ajax cgi.txt
#!/usr/bin/perl -w
use strict;
$| = 1;

###############################################
# Location:
# http://www.infocopter.com/perl/ajax.html
###############################################

use CGI::Ajax;
use CGI;
my $q = CGI->new();

#####  GLOBAL
my $Google_pattern_l = q~http://www.google.ch/custom?domains=www.infocopter.com&q=~;

my $Google_pattern_r = q~&sitesearch=www.infocopter.com&sa=Suchen&client=pub-2462448779608523&forid=1&channel=7029886459&ie=ISO-8859-1&oe=ISO-8859-1&cof=GALT%3A%239A2C06%3BGL%3A1%3BDIV%3A%2333FFFF%3BVLC%3AD03500%3BAH%3Acenter%3BBGC%3AFFFFCC%3BLBGC%3AE6E6E6%3BALC%3A440066%3BLC%3A440066%3BT%3A336699%3BGFNT%3A223472%3BGIMP%3A223472%3BLH%3A25%3BLW%3A106%3BL%3Ahttp%3A%2F%2Fwww.infocopter.com%2Fimages%2Flogo-ic-vsma.gif%3BS%3Ahttp%3A%2F%2F%3BFORID%3A1%3B&hl=de~;

my $Show_Form = sub {
	my $html = '';
	$html = q~<html>
		<head>
		<title>Ajax Demo</title>
		<link href="/mainwiki.css" rel="styleSheet" type="text/css">
		</head>
		<body>
	<img src="/images/redpoint.gif" width="9" height="9" alt="You are here"> <a href="http://www.infocopter.com/">iC Home</a> &gt;
	<a href="http://www.infocopter.com/perl/">Perl</a> &gt;
	<a href="http://www.infocopter.com/perl/documentation.html"> Documentation</a> &gt;
	<a href="http://www.infocopter.com/perl/ajax.html">Ajax</a> &gt; Demo
	<br /> <br />

		<h3>Ajax Demo</h3>
		<form name="myForm">
		<b>Input:</b> <input type="text" name="searchq" id="searchq" size="16"
			onkeyup="search( ['searchq'], ['rdiv'] ); return true;">
			Try: foo or reto<br><br>

		<span id="rdiv"></span>
		</form>
		<script language="JavaScript">
			document.myForm.searchq.focus();
		</script>
		</body>
		</html>~;
	$html;
};

&main();

sub main() {
	my $search_fx = sub {
		my $in = shift || '* no val *';

		my $html = '';
		return $html if length($in) < 2;

		my $ret = '';
		open(IN, '<ajax_input.txt') or print STDERR $!;
		while(<IN>) {
			if ($_ =~ /$in/i) {
				chomp;
				my ($key, $val) = split /\t/;
				(my $qsafe_val = &uri_escape($val)) =~ s/%/%25/g; # keep '%'
				$ret .= qq~$key &rarr; 
					<a href="$Google_pattern_l$qsafe_val$Google_pattern_r">
					$val</a><br>~;
			}
		}
		close IN;

		$html .= $ret ? '<b>Found results:</b><br>' . $ret : '';
		$html .= q~<br><a href="http://primus.pgate.net/ajax/linksearch/">Ajax Link Search</a>~;
		$html;
	};

	my $pjx = CGI::Ajax->new(
		search  => $search_fx,
	);

	$pjx->JSDEBUG(0);
	$pjx->DEBUG(0);

	print $pjx->build_html($q, $Show_Form); # this outputs the html for the page
}

sub uri_escape {
	my $text = $_[0];

	# Build a char to hex map
	my %escapes = ();
	for (0..255) { $escapes{chr($_)} = sprintf("%%%02X", $_); }

	# Default unsafe characters.  RFC 2732 ^(uric - reserved)
	$text =~ s/([^A-Za-z0-9\-_.!~*'()])/$escapes{$1}/g;
	$text;
}

Try it out: primus.pgate.net/ajax/↑

See also:

2.9 Cryptography

AES Tool - Online Utility: Know-how
AES Tool for the «Rijndael» cryptography algorithm.
www.infocopter.com/know-how/aes-tool.htm - 8k - Im Cache


[ perl corner ] > [ Cryptography ] > [ Crypt::Blowfish ] > [ Crypt::CBC ] > [ My::Crypt ] - [ More Perl Cryptography ]

String Encryption with crypt()

Common Algorithms (widely used)

DES, DES3, BLOWFISH, RC2, RC4, RC5, idea, CAST5

DES

The Data Encryption Standard (DES) is an algorithm developed in the mid-1970s. It was turned into a standard by the US National Institute of Standards and Technology (NIST), and was also adopted by several other governments worldwide. It was and still is widely used, especially in the financial industry.

DES is a block cipher with 64-bit block size. It uses 56-bit keys. This makes it suspectible to exhaustive key search with modern computers and special-purpose hardware. DES is still strong enough to keep most random hackers and individuals out, but it is easily breakable with special hardware by government, criminal organizations, or major corporations. DES is getting too weak, and should not be used in new applications.

A variant of DES, Triple-DES (also 3DES) is based on using DES three times (normally in an encrypt-decrypt-encrypt sequence with three different, unrelated keys). The Triple-DES is arguably much stronger than (single) DES, however, it is rather slow compared to some new block ciphers.

Nevertheless, even though DES seems to be of little interest for applications of today there are many reasons for considering it still important. It was the first block cipher which was widely deployed in the public sector. Thus it played an important role in making strong cryptography available to the public.

Also, the design was exceptionally good for a cipher that was meant to be used only a few years. DES proved to be a very strong cipher and it took over a decade for any interesting cryptanalytical attacks against it to develop (not to underestimate the pioneering efforts that lead to this breakthrough). The development of differential cryptanalysis and linear cryptanalysis opened ways to really understand the design of block ciphers.

Although at the time of DES's introduction its design philosophy was held secret, it did not discourage its analysis - to the contrary. Some information has been published about its design, and one of the original designers, Don Coppersmith, has commented that they discovered ideas similar to differential cryptanalysis already while designing DES in 1974. However, it was just matter of time that these fundamental ideas were re-discovered.

Even today, when DES is no longer considered a practical solution, it is often used to describe new cryptanalytical techniques. It is remarkable that even today, there are no cryptanalytical techniques that would completely break DES in a structural way, indeed, the only real weakness known is the short key size (and perhaps the small block size).


Blowfish

Blowfish was designed by Bruce Schneier. It is a block cipher with 64-bit block size and variable length keys (up to 448 bits). It has gained a fair amount of acceptance in a number of applications, including Nautilus and PGPfone.

Blowfish utilizes the idea of randomized S-boxes: while doing key scheduling, it generates large pseudo-random look-up tables by doing several encryptions. The tables depend on the user supplied key in a very complex way. This approach has been proven to be highly resistant against many attacks such as differential and linear cryptanalysis. Unfortunately it also means that it is not the algorithm of choice for environments where large memory space (something like than 4096 bytes) is not available.

The only known attacks against Blowfish are based on its weak key classes.


Sample Code:

Cryptographic Hash Functions
$crypted = crypt("hello", 'az'); # ---> 2AuDleQw6eOSg

print "Password?\n"; $try = ; chop $try;

if (crypt($try, '2AuDleQw6eOSg') eq '2AuDleQw6eOSg') {
        print "OK!\n";
}
else { print "<-- NOT OK! $try\n" }

How to generate a unique user id?

Sample Code:

use MD5;

$id = substr(MD5->hexhash(time(). {}. rand(). $$. 'abc'), 0, 8);

print "$id\n"; 
Description: last digit represents the exact length of the id.
Symetric encryption:
Crypt::CBC (DES-Verschlüsselung) 
$cipher = new Crypt::CBC $CONFIG{'key'}, 'DES';

$decoded = $cipher->decrypt($coded);

SHA-1 message digest algorithm

#!/usr/bin/perl -w
use strict;


# NIST SHA-1 message digest algorithm

use Digest::SHA1 qw(sha1_base64);

my $input    = 'Hello, World!';

print sha1_base64($input . 'secret'), "\n";
print sha1_base64($input . 'secre' ), "\n";
print sha1_base64($input . 'secr'  ), "\n";

Output:

AN60eYkPk7jOCcRvQvPY2zi0RO0
mbyHv9cckXre2Cs1urHi0XiXwDs
VY0Lzi7U0wRdACtVVMLlySn4m9o

2.10 Networking with Perl

Please move to next page.

2.10.1 LWP

This page has to be moved.

2.11 Graphics & Charts

Create Charts and Graphics with Perl

Installation of GD::Graph

RedHat Fedora Core 2
  1. perl-GD-2.16-1.1.fc2.rf.i386.rpm
  2. perl-GD-Text-Util-0.86-0.1.fc2.dag.i386.rpm
  3. iperl-GD-Graph-1.43-0.1.fc2.dag.i386.rpm
  4. perl -MCPAN -e "install GD::Graph::histogram"

Graph

Graph
→ Graphics charts code


See also:

2.11.1 Graphics & Charts - Code

files/graph lines pl.txt 
#!/usr/bin/perl -w
use strict;
use warnings;

use GD::Graph::lines;

print "Content-type: text/html\n\n";

&main();

#############################
sub main() {
#############################
	my @data = (
		["1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th"],
		[1, 5, 6, 7, 3.5, 2, 3, 4.5, 4.5],
		[1, 2, 5, 6, 3, 1.5, 1, 3, 4],
		[ sort { $a <=> $b } (1, 2, 5, 6, 3, 1.5, 1, 3, 4) ]
	);

	my $graph = GD::Graph::lines->new(400, 300);

	$graph->set(
		x_label		=> 'X Label',
		y_label		=> 'Y Label',
		title		=> 'Some simple graph',
		y_max_value	=> 8,
		y_tick_number	=> 8,
		y_label_skip	=> 2
	) or die $graph->error;

	my $format = $graph->export_format;
	open(IMG, ">graph_lines.$format") or die $!;
	binmode IMG;
	print IMG $graph->plot(\@data)->$format();
	close IMG;

	print qq~<a href="graph_lines.$format">graph_lines.$format</a>~;
}

files/histogram pl.txt 
#!/usr/bin/perl -w
use strict;
use GD::Graph::histogram;
use GD::Graph::Data;

my @data;
for (my $i = 0; $i < 100; $i++)
{
	push(@data, rand(50));
}

my $my_graph = GD::Graph::histogram->new;

my $name = 'histogram';

print STDERR "Processing $name\n";

$my_graph->set( 
	x_label         => 'X Label',
	y_label         => 'Count',
	title           => 'A Simple Histogram Chart',
	x_labels_vertical => 1,
	bar_spacing     => 0,
	shadow_depth    => 1,
	shadowclr       => 'dred',
	transparent     => 0,
	# histogram_bins => 4
	# histogram_type => 'percentage'
) 
or warn $my_graph->error;

$my_graph->plot(\@data) or die $my_graph->error;

my $ext = $my_graph->export_format;

open(OUT, ">$name.$ext") or die "Cannot open $name.$ext for write: $!";
binmode OUT;
print OUT $my_graph->gd->$ext();
close OUT;

2.12 Related Books

Recommended books from O'Reilly

2.13 Etc.

2.13.1 UTF-8, RNUTF-8TOP

Send HTTP response in UTF fashion

print $q->header('text/html; charset=UTF-8');

Most related pages

See also:

3 Data Encoding & Conversion

3.1   Web Encoding & Decoding
 3.1.1  Generic Web Encoding
3.2   Character Encoding
3.3   IDN Punycode

3.1 Web Encoding & Decoding

3.1   Web Encoding & Decoding
 3.1.1  Generic Web Encoding
3.2   Character Encoding
3.3   IDN Punycode

Following sub routine will return a Browser-safe encoded version of a given string.

E.g. From Zürich to Z&#252;rich 

sub web_enc ($) {
        my $enc = '';
        for (my $i = 0; $i < length($_[0]); $i++) {
                my $ordno = ord substr($_[0], $i, 1);
                $enc .= $ordno > 127 ? sprintf("&#%d;", $ordno) : substr($_[0], $i, 1);
        }

        $enc =~ s/ $//;;
        $enc;
}

Web-encoding (generic)

This code converts special characters to web-encoded characters independent of the character translation setting of the host (ISO or UTF).

#!/usr/bin/perl -w
use strict;

use Unicode::String qw(latin1 utf8);

open(IN, "<umlaute.txt") or print STDERR $!;
while(my $in = <IN>) {
	print "--> $in";
	my $text_iso  = (utf8($in))->latin1;
	my $text_utf8 = (latin1($text_iso))->utf8; # reverse check

	my $input = $text_iso;
	   $input = $in if $in ne $text_utf8; # Is ISO already!

	print '<-- ', &web_enc($input);
}
close IN;

sub web_enc ($) {
	my $enc = '';
	for (my $i = 0; $i < length($_[0]); $i++) {
		my $ordno = ord substr($_[0], $i, 1);
		$enc .= $ordno > 127 ? sprintf("&#%d;", $ordno) : substr($_[0], $i, 1);
	}

	$enc =~ s/ $//;;
	$enc;
}


See also:
Char encoding
To utf
Toiso
Url encoding (legacy)

3.1.1 Generic Web Encoding

X X X X X Independent of the character translation setting of the host (ISO or UTF).

→ Download/wget files/webenc generic inline pl.txt

#!/usr/bin/perl -w
use strict;

use Unicode::String qw(latin1 utf8);

print &web_enc($ARGV[0]), "\n";

sub web_enc ($) {
	return '' unless $_[0];

	local $SIG{'__WARN__'} = \&alarm_handler; # install signal handler

	my $in = $_[0];
	my $text_iso  = (utf8($in))->latin1;
	my $text_utf8 = (latin1($text_iso))->utf8; # reverse check

	my $input = $text_iso;
	   $input = $in if $in ne $text_utf8; # Is ISO already!

	my $enc = '';
	for (my $i = 0; $i < length($input); $i++) {
		my $ordno = ord substr($input, $i, 1);
		$enc .= $ordno > 127 ? sprintf("&#%d;", $ordno) : substr($input, $i, 1);
	}

	$enc =~ s/ $//;;
	$enc;
}

sub alarm_handler () {
	#print STDERR "alarm catched!\n";
	return;
}


See also:

3.2 Character Encoding

3.1   Web Encoding & Decoding
 3.1.1  Generic Web Encoding
3.2   Character Encoding
3.3   IDN Punycode

Check, if a string is an ASCII string or not

#!/usr/bin/perl -w
$| = 1;
use strict;

my $in = $ARGV[0] || 'foo';

print "\"$in\" is ... ";

if (&is_ascii($in)) {
        print "ASCII\n";
}
else {
        print "Non ASCII\n";
}

sub is_ascii($) {
        for (my $i = 0; $i < length($in); $i++) {
                if (unpack('C', substr($in, $i, 1)) > 127) {
                        return 0;
                }
        }
        return 1;
}


See also:
Web encoding decoding

3.3 IDN Punycode

IDNA::Punycode is a module to encode / decode Unicode strings into Punycode, an efficient encoding of Unicode for use with IDNA.

Example

#!/usr/bin/perl -w
use strict;

use IDNA::Punycode;
use Unicode::String qw(latin1 utf8);

my $in = utf8($ARGV[0]);
my $in_ok = ($in->latin1);

my $punycode = encode_punycode($in_ok);

print "$ARGV[0]\n$punycode\n";

Usage

./punycode.pl bücher
bücher
xn--bcher-kva


See also:

4 Date & Time in Perl

4.1   Date & Time Calculations (Date::Manip)
4.2   Format Time
4.3   Calculate Easter Day
4.4   Calculate Weekday
4.5   Related Date & Time Links

Common usage

my $tstamp = time();
my ($y, $m, $d, $ss, $mm, $hh) = (localtime($tstamp))[5,4,3,0,1,2];
$y += 1900;
$m += 1;

A timestamp function

sub tstamp () {
        my ($y, $m, $d, $ss, $mm, $hh) = (localtime())[5,4,3,0,1,2];
        $y += 1900;
        $m += 1;
        sprintf("%d%02d%02d%02d%02d%02d", $y, $m, $d, $hh, $mm, $ss);
}

Convert epoch seconds into a human-readable date

$ cat epoch.pl 
#!/usr/bin/perl -w
use strict;
use Date::Manip;

my $epoch = $ARGV[0] || time() - 3600 * 24; # yesterday

print "-> epoch = $epoch\n";

my $date = &ParseDateString("epoch $epoch");

print "<- $date\n";


See also:
/perl/date time

4.1 Date & Time Calculations (Date::Manip)

[retoh@secundus date]$ cat date.pl

#!/usr/bin/perl -w
$| = 1;
use strict;
use Date::Manip;

# -- GLOBAL
# my $tz = Date_TimeZone();
my $date_res;
my @MM_NAMES = qw(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC);

# -- MAIN
$date_res = &getNext(date => '2005-04-20', add => '+ 48hours');
print '<-- Weekday ', $date_res->{'weekday_num'}, "\n";
print '<-- ', $date_res->{'date_eu'}, "\n";
print "\n";

$date_res = &getNext(date => '2005-04-30');
print '<-- Weekday ', $date_res->{'weekday_num'}, "\n";
print '<-- ', $date_res->{'date_eu'}, "\n";


######################################################
sub getNext(%) {
######################################################
	my %args = @_;

	$args{'add'} ||= '+ 24hours';
	my %result = ();

	my ($i_yyyy, $i_mm, $i_dd) = split /\-/, $args{'date'};

	print "--> Input: $i_dd $MM_NAMES[$i_mm - 1] $i_yyyy $args{'add'}\n";

	$result{'weekday_num'} = Date_DayOfWeek($i_mm, $i_dd, $i_yyyy);

	my $err = '';
	my $date = DateCalc("$i_dd $MM_NAMES[$i_mm - 1] $i_yyyy",
			$args{'add'}, \$err) || '';
	$err ||= 0;

	my $yyyy = substr($date, 0, 4);
	my $dd   = substr($date, 4, 2);
	my $mm   = substr($date, 6, 2);

	$result{'date_eu'} = "$mm\.$dd\.$yyyy";

	\%result;
}

Output

$ ./date.pl
--> Input: 20 APR 2005 + 48hours
<-- Weekday 3
<-- 22.04.2005

--> Input: 30 APR 2005 + 24hours
<-- Weekday 6
<-- 01.05.2005

4.2 Format Time

Problem

You want to generate a MySQL 4.x compatible time string. You also may move back and forward in time by adding specfic amount of seconds where installing fat Date modules would be an overkill.

Output

Now:            20060703103634
Before 1 hour:  20060703093634
Before 6 hours: 20060703043634

The Code

#!/usr/bin/perl -w
use strict;

print 'Now:            ', &formatTime(str => scalar localtime(time() -     0)), "\n";
print 'Before 1 hour:  ', &formatTime(str => scalar localtime(time() -  3600)), "\n";
print 'Before 6 hours: ', &formatTime(str => scalar localtime(time() - 21600)), "\n";

sub formatTime(%) {
	my %args = @_;
	$args{'str'} ||= ''; # e.g. Mon Jul 3 12:59:28 2006

	my @elems = ();
	foreach (split / /, $args{'str'}) {
		next unless $_;
		push(@elems, $_);
	}

	my ($weekday, $month, $mday, $time, $yyyy) = split / /, join(' ', @elems);

	my %months = (  Jan => 1, Feb => 2, Mar => 3, Apr =>  4, May =>  5, Jun =>  6,
			Jul => 7, Aug => 8, Sep => 9, Oct => 10, Nov => 11, Dec => 12 );

	my $s  = substr($time, 6,2);
	my $m  = substr($time, 3,2);
	my $h  = substr($time, 0, 2);
	my $dd = sprintf('%02d', $mday);

	my $mm_num = sprintf('%02d', $months{$month});

	#my $formatted = "$yyyy\-$mm_num\-$dd $h:$m:$s";
	my $formatted = "$yyyy$mm_num$dd$h$m$s";

	$formatted;
}

Download → files/format time pl.txt

4.1   Date & Time Calculations (Date::Manip)
4.2   Format Time
4.3   Calculate Easter Day
4.4   Calculate Weekday
4.5   Related Date & Time Links


See also:

4.3 Calculate Easter Day

Submitted by Rolf Rost 

########## Ostersonntag nach Gauss

# ostern("year") Gibt das Datum des Ostersonntages zurück, berechnet nach Gauss.
# Der Ostersonntag nach Gauss berechnet
sub ostern{
 my $X = shift;
 my $mon = 3;
 my $K = int( $X / 100 );
 my $M = 15 + int(( 3*$K+3 ) / 4 ) - int(( 8*$K+13 ) / 25 );
 my $S = 2 - int(( 3*$K+3 ) / 4 );
 my $A = $X % 19 ;
 my $D = (19*$A+$M) % 30 ;
 my $R = int( $D / 29 ) + ( int( $D / 28 ) - int( $D / 29 )) * int( $A / 11 );
 my $OG = 21 + $D - $R;
 my $SZ = 7 - ( $X + int( $X / 4 ) + $S) % 7 ;
 my $OE = 7 - ( $OG - $SZ ) % 7;
 my $OS = $OG + $OE;
 $mon = 4 if $OS > 31;
 $OS = $OS - 31 if $OS > 31;
 return "$OS.$mon.$X";
}

4.4 Calculate Weekday

Theodor::Wagner

Calculates each weekday; based on Theodor Wagners modell «Ewiger Kalender»

4.5 Related Date & Time Links

5 XML with Perl

5.1   RSS 2.0
5.2   XML RPC
 5.2.1  XML::Parser
5.3   SOAP
 5.3.1  SOAP Error Handling
 5.3.2  SOAP Basic Authorization
 5.3.3  SOAP Array
 5.3.4  Google SOAP
 5.3.5  SOAP Examples
5.4   eBay API
 5.4.1  Example: get Ebay Time

Cooking XML with Perl

Overview

Related Books

Related Links



Continue...

5.1 RSS 2.0

rss_2_0_simple.pl

Download: → /perl/ files/rss 2 0 simple pl.txt 
#!/usr/bin/perl -w
use strict;
$| = 1;
################################
# rss_2_0.pl
################################

use XML::GDOME;

# -- GLOBAL
my $DEBUG = 0;
my $doc = XML::GDOME->createDocFromURI($ARGV[0]);
my @nodes = $doc->findnodes("//*");
my $do = my $i = 0;

foreach my $node (@nodes) {
        my @childs = $node->childNodes;

        foreach my $child (@childs) {
                if($child->nodeType == ELEMENT_NODE) {
                        my $data = defined $child->firstChild() ? 
                               $child->firstChild()->data : 'NULL';
			if ($child->nodeName eq 'title') {
				$i++;
				$do = 1 if $i > 1;
			}
			next unless $do;
			chomp $data;

                        print "[DEBUG] node = '",  $child->nodeName, "'\n" if $DEBUG;
			if ($child->nodeName eq 'title') {
				print '<b>', $data, '</b>', "\n";
			}
			elsif ($child->nodeName eq 'link') {
				print '<a href="', $data, '">', $data, '"</a>', "\n";
			}
			elsif ($child->nodeName eq 'description') {
				print $data, '<br />', "\n";
			}
			elsif ($child->nodeName eq 'pubDate') {
				print '<i>(', $data, ')<br /></i>';
				print "<hr noshade>\n\n";
			}
			else {
				print $data, '<br />';
			}
                }
        }
}

__END__

rss_2_0.pl

Download: → /perl/ files/rss 2 0 pl.txt 
#!/usr/bin/perl -w
use strict;
$| = 1;
################################
# rss_2_0.pl
#
# URL: http://www.infocopter.com/perl/rss.html
# Location: quartus
#
# Usage:
# rss_2_0.pl [Options] rssinput.xml "3" >output_top3.html
#
my $VERSION = '0.05.02';
################################

use XML::GDOME;
use Unicode::String qw(latin1 utf8); # For Umlaute problems -> web_enc / toISO
use Getopt::Long;

# -- GLOBAL
my $DEBUG = 0;
my $do = my $i = 0;
my %META = ();
# -- Don't make a target _blank to this domains:
my @HOME_DOMAINS = qw(infocopter.com pgate.net);

my @getopt_args = (
	'd',		# debug
	'debug' ,	# debug mode for development support
	'omit_tags=s' ,	# e.g. img,a,h1
	'h',		# help
	'proxy=s',	# proxy host
	'v',		# Verbose mode
);

my %Options;
Getopt::Long::config("noignorecase", "bundling");

print "\n";
&Usage() unless GetOptions(\%Options, @getopt_args);

if ($Options{'d'} or $Options{'debug'}) {
	foreach (keys %Options) { print "- $_ = \"$Options{$_}\"\n"; }
}
$Options{'omit_tags'} ||= '';

my $doc = XML::GDOME->createDocFromURI($ARGV[0] || '/var/www/html/rss/xml/linuxjournal.xml');
my @nodes = $doc->findnodes("//*");

&main();

###############################################
sub main() {
###############################################
	my @row_color = ();
	   $row_color[0] = 'white';
	   $row_color[1] = '#e9e9e9';

	#print '<table cellspacing="0" cellpadding="3" border="0" style="border-color:black;">';

	print '<tr><td>', scalar localtime, '<br /></td></tr>';

	my $i = 0;
	my $max = $ARGV[1] || 0;
	foreach (&parseRSS()) {
		my $hash_ref = $_;
		next if $hash_ref->{'title'} =~ /^ADV:/; # Skip advertisting

		last if (++$i > $max) && $max;

		(my $description = $hash_ref->{'description'}) =~ s/^<p>//gi;
		    $description =~ s/<\/p>$//gi;
		    $description =~ s/<\/p>/<br \/><br \/>/gi;
		    $description =~ s/<p>//gi;
		    $description =~ s/’/'/g;
		    $description =~ s/é/\&eacute;/g;
		    $description =~ s/è/\&egrave;/g;
		    if (&isISO($description)) {
		    	$description = &web_enc($description);
		    }
		    else {
		    	$description = &web_enc(&toISO($description));
		    }
		my @omit_tag_arr = split /,/, $Options{'omit_tags'};
		foreach (@omit_tag_arr) {
			$description =~ s/\<$_/\&lt;$_/g;
		}

		if ($hash_ref->{'__nodeName'} !~ /description/) {
			# Something else, probably the disclaimer section but to be generic we catch all ;-)
			print	'<tr bgcolor="white">',
				'<td style="border-bottom-style:dashed; ',
				  'border-bottom-color:#cccccc; border-bottom-width:1px;">';
			if (defined $hash_ref->{'url'}) {
				print '<a target="_blank" href="', $hash_ref->{'link'}, '">',
					'<img border="0" src="', $hash_ref->{'url'}, '" alt="',
					$hash_ref->{'title'}, '"></a>';
			}
			else {
				foreach (keys %{$hash_ref}) {
					print "$_ = ", $hash_ref->{$_}, '<br />';
				}
			}
			print '</td></tr>';
			$i--;
			next;
		}
		else {
			print '<tr bgcolor="', $row_color[$i % 2],
				'"><td style="border-bottom-style:dashed; ',
					'border-bottom-color:#cccccc; border-bottom-width:1px;">';
		}

		my $title = $hash_ref->{'title'};
		   $title =~ s/’/'/g;
		   $title =~ s/é/\&eacute;/g;
		   $title =~ s/è/\&egrave;/g;
		if (&isISO($title)) {
			$title = &web_enc($title);
		}
		else {
			$title = &web_enc(&toISO($title));
		}

		print '<span style="font-size:16px;font-weight:bold">', $title, '</span><br />',
			'<span style="font-size:10px">', $hash_ref->{'pubDate'}, '</span><br />',
			$description, '<br /> <br />', "\n";

		if ($hash_ref->{'category'}) {
			print '&rsaquo; <a href="', $hash_ref->{