Using regular expressions for XML Parsing and Templating all in the one script because I still didn't know of the CPAN. Apart from some 'hello world' scripts this was the first script I wrote (2001).
Good or Bad the script is still used today on my little brothers
website
The code:
#! /usr/bin/perl -w
use strict;
use CGI;
# cgi
my $q = CGI->new();
# file descriptions
my $isnotfile = "_isnot/isnot.xml";
my $isnottemplate = "_isnot/isnot.tmpl";
# general vars
my $news_template_file;
my $page_template_file;
###################################################################
# Main
###################################################################
print $q->header;
print displaypage(getdata($isnotfile), $isnottemplate);
# end.
###################################################################
# Subs
###################################################################
sub getdata {
my ($file) = shift;
my $isnotdata = [];
open (DATA, "< $file") || die_nice('swink is not, well.. is not wo
+rking, call back later');
while (my $line = <DATA>){
if ($line =~ m/<isnot(.*?)>(.*?)<\/isnot>/i){
my $isnot = {};
my $attributes = $1;
$isnot->{text} = $2;
warn "text: ".$isnot->{text}."#end\n\n";
if ($attributes =~ m/date="(.*?)"/i){
$isnot->{date} = $1;
}
if ($attributes =~ m/user="(.*?)"/i){
$isnot->{user} = $1;
}
if ($attributes =~ m/email="(.*?)"/i){
$isnot->{email} = $1;
}
push (@$isnotdata, $isnot);
}
}
close DATA;
return $isnotdata;
}
###################################################################
sub displaypage {
my ($isnotdata, $template_file) = @_;
my $template;
open (TEMPLATE, "< $template_file") || die_nice('swink is not, wel
+l.. is not working, call back later');
while (<TEMPLATE>){
$template .= $_;
}
close TEMPLATE;
my $isnot_html;
foreach my $isnot (@$isnotdata){
$isnot_html .= $isnot->{date}.' - '.$isnot->{text}.' (<a href=
+"mailto:'.$isnot->{email}.'">'.$isnot->{user}.'</a>)<br />';
}
$template =~ s/<!--#isnot#-->/$isnot_html/i;
return $template;
}
###################################################################
sub die_nice {
my ($message) = shift;
print $q->header;
print $message;
exit(1);
}