=head1 Embperl - How to Build Large Scale Websites/Webapplications With Perl
O'Reilly OpenSource Convention 2002
Gerald Richter
ecos gmbh
http://www.ecos.de
=head1 The Embperl Website
=head2 Documentation are written in POD, Output should be HTML and PDF
=head2 Database for storing new, articles, sites useing Embperl and other Links.
=head2 Inclusion of various document formats (HTML, binary etc.)
=head2 Multilanguage (german, english)
=head1 The Layout
=head2 The starting page...
http://perl.apache.org/embperl/ or http://www.ecos.de/embperl/
=head2 The components of the page...
=pic /eg/images/base.gif
=head2 base.epl
[-
$r = shift ;
$http_headers_out{'content-type'} = 'text/html' ;
-]
Embperl
[- Execute ('header.epl') -]
| [- Execute ('menuleft.epl') -] |
|
|
|
[- Execute ('content.epl') -] |
|
|
|
[- Execute ('footer.htm') -]
=head2 content.epl
[- Execute ({'*') -] |
|
|
|
[- Execute ('news.epl') -]
|
=head1 Embperl's objects
=head2 The request-object
Makes data about the request avaiable, like URI, HTTP-header, form data
=head2 The component-object
Makes data about the component available, like filename, syntax, recipe
=head2 The application-object
Brings together the data of a set of pages that forms an application.
Like session handling, logging and configuration.
=head1 Embperl::Object
=head2 Embperl::Object manages the calling and overriding of components
=over
=item 1.) Createing of the request-object and populating it with informations about the request
=item 2.) Loading of the base template
Starting at the directory that contains the file that is requested,
Embperl::Object searches the directory hierachie up to the document root
(or EMBPERL_OBJECT_STOPDIR) for the base template.
All dierectories of this search are now part of the search path
for loading all file in this request. That is not only true for other
Embperl components, but also for other files like XSL sytlesheets.
=item 3.) Application-object searching and loading
=item 4.) Setting of the inherence
Application-File
|
v
Embperl::App
=item 5.) calling the init method of the application object
This allows to execute application specific code (like database access)
and modify the request. In a MCV modell this is the controller.
=item 6.) Loading of the actual requested page and blessing of the request object into the
package of this page
=item 7.) Setting the inherence of the request-object
Requested page
|
v
Base template
|
v
Embperl::Req
=item 8.) Executing the base template
=back
=head1 The application-object of the Embperl Website
=head2 Parts of the base application
sub init
{
my $self = shift ;
my $r = shift ;
my $config = Execute ({object => 'config.pl', syntax => 'Perl'}) ;
$config -> new ($r) ;
$r -> {config} = $config ;
$r -> {menu} = $config -> get_menu ($r) ;
fill_menu ($config, $r -> {menu}, $r -> {baseuri}, $r -> {root}) ;
$pf = map_file ($r) ;
$r -> param -> filename ($pf) ;
Execute ({inputfile => 'messages.pl', syntax => 'Perl'}) ;
return 0 ;
}
=head2 The configuration (config.pl)
BEGIN
{
%messages = (
'de' =>
{
'Introduction' => 'Einführung',
'Documentation' => 'Dokumentation',
'Examples' => 'Beispiele',
'Changes' => 'Änderungen',
'Sites using Embperl' => 'Websites mit Embperl',
'Add info about Embperl' => 'Hinzufügen über Embperl',
}
) ;
@menu = (
{ menu => 'Home', uri => '', file => { en => 'eg/web/index.htm',
de => 'eg/web/indexD.htm'} },
{ menu => 'Features', uri => 'pod/Features.htm', file => 'Features.pod' },
{ menu => 'Introduction', uri => 'pod/intro/', sub =>
[
{ menu => 'Embperl', uri => 'Intro.htm', file => { en => 'Intro.pod',
'de' => 'IntroD.pod'}},
{ menu => 'Embperl::Object', uri => 'IntroEmbperlObject.htm', file => 'IntroEmbperlObject.pod'},
]
},
{ menu => 'Documentation', uri => 'pod/doc/', sub =>
[
{ menu => 'Embperl', uri => 'Embperl.htm', file => { en => 'Embperl.pod',
de => 'EmbperlD.pod'}},
{ menu => 'Embperl::Object', uri => 'EmbperlObject.htm', file => 'Embperl/Object.pm'},
{ menu => 'Embperl::Syntax', uri => 'EmbperlSyntax.htm', file => 'Embperl/Syntax.pm', sub =>
[
{ menu => 'Embperl', uri => 'Embperl.htm', file => 'Embperl/Syntax/Embperl.pm'},
{ menu => 'EmbperlBlocks', uri => 'EmbperlBlocks.htm', file => 'Embperl/Syntax/EmbperlBlks.pm'},
{ menu => 'EmbperlHTML', uri => 'EmbperlHTML.htm', file => 'Embperl/Syntax/EmbperlHTML.pm'},
{ menu => 'HTML', uri => 'HTML.htm', file => 'Embperl/Syntax/HTML.pm'},
{ menu => 'ASP', uri => 'ASP.htm', file => 'Embperl/Syntax/ASP.pm'},
{ menu => 'SSI', uri => 'SSI.htm', file => 'Embperl/Syntax/SSI.pm'},
{ menu => 'Perl', uri => 'Perl.htm', file => 'Embperl/Syntax/Perl.pm'},
{ menu => 'POD', uri => 'POD.htm', file => 'Embperl/Syntax/POD.pm'},
{ menu => 'Text', uri => 'Text.htm', file => 'Embperl/Syntax/Text.pm'},
{ menu => 'RTF', uri => 'RTF.htm', file => 'Embperl/Syntax/RTF.pm'},
{ menu => 'Mail', uri => 'Mail.htm', file => 'Embperl/Syntax/Mail.pm'},
],
},
{ menu => 'Embperl::Recipe', uri => 'EmbperlRecipe.htm', file => 'Embperl/Recipe.pm', sub =>
[
{ menu => 'Embperl', uri => 'Embperl.htm', file => 'Embperl/Recipe/Embperl.pm'},
{ menu => 'EmbperlXSLT', uri => 'EmbperlXSLT.htm', file => 'Embperl/Recipe/EmbperlXSLT.pm'},
{ menu => 'XSLT', uri => 'XSLT.htm', file => 'Embperl/Recipe/XSLT.pm'},
],
},
],
},
{ menu => 'Installation', uri => 'pod/INSTALL.htm', file => 'INSTALL.pod' },
{ menu => 'FAQ', uri => 'pod/Faq.htm', file => 'Faq.pod' },
{ menu => 'Tips & Tricks', uri => 'pod/TipsAndTricks.htm', file => 'TipsAndTricks.pod' },
{ menu => 'Examples', uri => 'examples/' },
{ menu => 'Changes', uri => 'pod/Changes.htm', file => 'Changes.pod' },
{ menu => 'Sites using Embperl', uri => 'pod/Sites.htm', file => 'Sites.pod' },
{ menu => 'News', uri => 'db/news/news.htm', file => 'eg/web/db/data.epd',
fdat => { 'category_id' => 1 } },
{ menu => 'Sites using Embperl', uri => 'db/sites/sites.htm', file => 'eg/web/db/data.epd',
fdat => { 'category_id' => 2 } },
{ menu => 'Add info about Embperl', uri => 'db/addsel.epl', same =>
[
{ menu => 'Select category', uri => 'db/add.epl' },
{ menu => 'Review added info', uri => 'db/show.epl'},
{ menu => 'Show info', uri => 'db/data.epd' },
],
},
) ;
} ;
sub new
{
my ($self, $r) = @_ ;
# The following two values must be changed to meet your local setup
# Additionaly DBI and DBIx::Recordset must be installed
$self -> {dbdsn} = $^O eq 'MSWin32'?'dbi:ODBC:embperl':'dbi:mysql:embperl' ;
$self -> {dbuser} = 'www' ;
$self -> {dbpassword} = undef ;
}
sub get_menu
{
my ($self, $r) = @_ ;
push @{$r -> messages}, $messages{$r -> param -> language} ;
return \@menu ;
}
=head1 The navigation
[$ sub menuitem $]
[*
my ($url, $txt, $state, $tablebg, $ndx) = @_ ;
*]
|
|
[$ endsub $]
[$ sub menu $]
[*
my ($menu, $ndx, $top) = @_ ;
*]
[$ foreach my $item (@{$menu}) $]
[-
if ( $r -> {menuitems}[$ndx] eq $item)
{
menuitem ($item -> {url}, $item -> {menu}, $r -> {menuitems}[$ndx+1]?2:3, $top, $ndx) ;
menu ($item -> {sub}, $ndx + 1, 0) if ($item -> {sub}) ;
}
else
{
menuitem ($item -> {url}, $item -> {menu}, 0, $top, $ndx) ;
}
-]
|
[$endforeach $]
[$ endsub $]
[-
$r = shift ;
-]
|
| |
[- menu ($r -> {menu} , 0, 1) -]
| |
|
| |
|
| Stable
1.3.4 |
|
|
|
|
Beta 2.0b8 |
|
=head1 The news column of the home page
[-
use DBIx::Recordset ;
$r = shift ;
*set = DBIx::Recordset -> Search ({'!DataSource' => $r -> {dbdsn},
'!Username' => $r -> {dbuser},
'!Password' => $r -> {dbpassword},
'!DBIAttr' => { RaiseError => 1, PrintError => 1,
LongReadLen => 32765, LongTruncOk => 0, },
'!Table' => 'item, itemtext',
'!TabRelation' => 'item_id = item.id',
'!Order' => 'creationtime desc',
'language_id' => $r -> param -> language,
'category_id' => 1,
'$max' => 15}) ;
-]
|
| |
[$while ($rec = $set -> Next)$]
|
[+ $rec -> {heading} +]
|
|
|
[-
$txt = $rec -> {description} ;
$txt =~ s#<#<#g ;
$txt =~ s#>#>#g ;
$txt =~ s#B<(.*?)>#$1#g ;
$txt =~ s#(http://[-a-zA-Z.]+)#$1#g ;
-]
[+ do { local $escmode = 0 ; $txt } +]
|
|
[$endwhile $]
|
=head1 Syntaxes, Recipes and Provider
=head2 The execution of a component is divied in multiple steps.
Every step is done by a separate provider.
=head2 Recipes defines in which order providers are executed.
=head2 This could be a simple linear structure or even a complex tree structure.
=head2 The Defaultrecipe: 'Embperl'
=over 4
=item Read the source (File, Memory)
=item Parse
=item Compile
=item Execute
=item Output
=back
=head2 The syntax tells the parser and compiler what input format they should expect
Examples: Embperl, ASP, SSI, Perl, Text, POD, RTF
=head2 You can create your own syntax by writing a new syntax class.
=head2 You can extented an existing syntax by inherenting from an existing class
=head2 Every intermediate step and the result can be cached
=head1 Rendering POD to HTML via XML and XSLT
=head2 The syntax POD transforms POD to XML
=head1 NAME
Embperl
=head1 Description
Here we have some text
will become
Embperl
Here we have some text
This basicly generates the same XML as Pod::XML
=head2 The Recipe EmbperlXSLT
=over 4
=item Read the source (File, Memory)
=item Parse
=item Compile
=item Execute
=over 4
=item Read the stylesheet
=item "Compile" the stylesheet
=back
=item "Compile" the result of the Executing of the primary source
=item XSLT Transformation
=item Output
=back
=head2 The usage of the XSLT Transformation allows the creation of different layouts
from the same source.
=head2 By transformation into XSL-FO and appending of the XSL-FO Provider it's easly possible create
PDF's
=head2 pod/content.epl
[- Execute ({inputfile => '*'}) -]
=head2 The recipe for the Embperl web is provided by the application object
sub get_recipe
{
my ($class, $r, $recipe) = @_ ;
my $self ;
my $param = $r -> component -> param ;
my $config = $r -> component -> config ;
my ($src) = $param -> inputfile =~ /^.*\.(.*?)$/ ;
my ($dest) = $r -> param -> uri =~ /^.*\.(.*?)$/ ;
if ($src eq 'pl')
{
$config -> syntax('Perl') ;
return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
}
if ($src eq 'pod' || $src eq 'pm')
{
$config -> escmode(0) ;
if ($dest eq 'pod')
{
$config -> syntax('Text') ;
return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
}
$config -> syntax('POD') ;
if ($dest eq 'xml')
{
return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
}
$config -> xsltstylesheet('pod.xsl') ;
$r -> param -> uri =~ /^.*\/(.*)\.(.*?)$/ ;
$param -> xsltparam({
page => $fdat{page} || 0,
basename => "'$1'",
extension => "'$2'",
imageuri => "'$r->{imageuri}'",
baseuri => "'$r->{baseuri}'",
}) ;
return Embperl::Recipe::EmbperlXSLT -> get_recipe ($r, $recipe) ;
}
if ($src eq 'epd')
{
$config -> escmode(0) ;
$config -> options($config -> options | &Embperl::Constant::optKeepSpaces) ;
if ($dest eq 'pod')
{
$config -> syntax('EmbperlBlocks') ;
return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
}
$config -> xsltstylesheet('pod.xsl') ;
$r -> param -> uri =~ /^.*\/(.*)\.(.*?)$/ ;
$param -> xsltparam({
page => $fdat{page} || 0,
basename => "'$1'",
extension => "'$2'",
imageuri => "'$r->{imageuri}'",
baseuri => "'$r->{baseuri}'",
}) ;
return Embperl::Recipe::EmbperlPODXSLT -> get_recipe ($r, $recipe) ;
}
if ($src eq 'epl' || $src eq 'htm')
{
$config -> syntax('Embperl') ;
return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
}
$config -> syntax('Text') ;
return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
}
=head1 The database application
=head2 Separation of Code, Layout and Data
=head2 db/epwebapp.pl
use DBIx::Recordset ;
BEGIN { Execute ({isa => '../epwebapp.pl'}) ; }
sub init
{
my $self = shift ;
my $r = shift ;
$self -> SUPER::init ($r) ;
$self -> initdb ($r) ;
my $db = $r -> {db} ;
$r -> {language_set} = DBIx::Recordset -> Search ({'!DataSource' => $db,
'!Table' => 'language'}) ;
if ($fdat{-add_category})
{
$self -> add_category ($r) ;
$self -> get_category($r) ;
}
elsif ($fdat{-add_item})
{
$self -> add_item ($r) ;
$self -> get_category($r) ;
$self -> get_item_lang($r) ;
}
elsif ($fdat{-show_item})
{
$self -> get_category($r) ;
$self -> get_item_lang($r) ;
}
else
{
$self -> get_category($r) ;
$self -> get_item($r) ;
}
return 0 ;
}
# ----------------------------------------------------------------------------
sub initdb
{
my $self = shift ;
my $r = shift ;
$DBIx::Recordset::Debug = 2 ;
*DBIx::Recordset::LOG = \*STDERR ;
my $db = DBIx::Database -> new ({'!DataSource' => $r -> {dbdsn},
'!Username' => $r -> {dbuser},
'!Password' => $r -> {dbpassword},
'!DBIAttr' => { RaiseError => 1, PrintError => 1,
LongReadLen => 32765, LongTruncOk => 0, },
}) ;
$db -> TableAttr ('*', '!SeqClass', "DBIx::Recordset::FileSeq,$r->{root}/db") if ($^O eq 'MSWin32') ;
$db -> TableAttr ('*', '!Filter',
{
'creationtime' => [\¤t_time, undef, DBIx::Recordset::rqINSERT ],
'modtime' => [\¤t_time, undef, DBIx::Recordset::rqINSERT + DBIx::Recordset::rqUPDATE ],
}) ;
$r -> {db} = $db ;
}
# ----------------------------------------------------------------------------
sub current_time
{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
$mon++ ;
$year += 1900 ;
return "$year-$mon-$mday $hour:$min:$sec" ;
}
# ----------------------------------------------------------------------------
sub add_category
{
my $self = shift ;
my $r = shift ;
my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
'!Table' => 'category',
'!Serial' => 'id',
state => 0}) ;
my $id = $$set -> LastSerial ;
my $langset = $r -> {language_set} ;
my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
'!Table' => 'categorytext'}) ;
$$langset -> Reset ;
while ($rec = $$langset -> Next)
{
$$txtset -> Insert ({category_id => $id,
language_id => $rec->{id},
category => $fdat{"category_$rec->{id}"}}) if ($fdat{"category_$rec->{id}"}) ;
delete $fdat{"category_$rec->{id}"} ;
}
}
# ----------------------------------------------------------------------------
sub add_item
{
my $self = shift ;
my $r = shift ;
my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
'!Table' => 'item',
'!Serial' => 'id',
url => $fdat{url},
category_id => $fdat{category_id},
state => 0}) ;
my $id = $$set -> LastSerial ;
my $langset = $r -> {language_set} ;
my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
'!Table' => 'itemtext'}) ;
$$langset -> Reset ;
while ($rec = $$langset -> Next)
{
$$txtset -> Insert ({item_id => $id,
language_id => $rec->{id},
description => $fdat{"description_$rec->{id}"},
url => $fdat{"url_$rec->{id}"} || $fdat{url},
heading => $fdat{"heading_$rec->{id}"}}) if ($fdat{"heading_$rec->{id}"}) ;
}
$fdat{item_id} = $id ;
}
# ----------------------------------------------------------------------------
sub get_category
{
my $self = shift ;
my $r = shift ;
$r -> {category_set} = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
'!Table' => 'category, categorytext',
'!TabRelation' => 'category_id = category.id',
'language_id' => $r -> param -> language,
$fdat{category_id}?(category_id => $fdat{category_id}):()}) ;
}
# ----------------------------------------------------------------------------
sub get_item
{
my $self = shift ;
my $r = shift ;
$r -> {item_set} = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
'!Table' => 'item, itemtext',
'!TabRelation' => 'item_id = item.id',
'language_id' => $r -> param -> language,
$fdat{category_id}?(category_id => $fdat{category_id}):(),
$fdat{item_id}?(item_id => $fdat{item_id}):()}) ;
}
# ----------------------------------------------------------------------------
sub get_item_lang
{
my $self = shift ;
my $r = shift ;
$r -> {item_set} = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
'!Table' => 'item, itemtext, language',
'!TabRelation' => 'item_id = item.id and language_id = language.id',
$fdat{category_id}?(category_id => $fdat{category_id}):(),
$fdat{item_id}?(item_id => $fdat{item_id}):()}) ;
}
=head2 db/addsel.epl
[- $r = shift -]
[= addsel1 =]
=head1 Multi-Language-Support
=head2 messages.pl stores the different texts
$r = shift ;
%messages =
(
'de' =>
{
'addsel1' => 'Klicken Sie auf die Kategorie zu der Sie etwas hinzufügen möchten:',
'addsel2' => 'oder fügen Sie eine neue Kategorie hinzu. Bitte geben Sie die Beschreibung ein.',
'addsel3' => 'Falls Sie die Übersetzung nicht wissen, lassen Sie das entsprechende Eingabefeld leer.',
'addsel4' => 'Kategorie hinzufügen',
'add1' => 'Hinzufügen eines neuen Eintrages zu',
'add2' => 'Bitte geben Sie die Beschreibung in so vielen Sprachen wie Ihnen möglich ein.',
'add3' => 'Hinzufügen zu',
'heading' => 'Überschrift',
'url' => 'URL',
'description' => 'Beschreibung',
'show2' => 'Folgender Eintrag wurde erfolgreich der Datenbank hinzugefügt',
},
'en' =>
{
'addsel1' => 'Click on the category for wich you want to add a new item:',
'addsel2' => 'or add new category. Please enter the description in as much languages as possible.',
'addsel3' => 'If you don\'t know the translation leave the corresponding input field empty.',
'addsel4' => 'Add category',
'add1' => 'Add a new item to',
'add2' => 'Please enter the description in as much languages as possible.',
'add3' => 'Add to',
'heading' => 'Heading',
'url' => 'URL',
'description' => 'Description',
'show2' => 'The following entry has been sucessfully added to the database',
},
) ;
$lang = $r -> param -> language ;
push @{$r -> messages}, $messages{$lang} ;
push @{$r -> default_messages}, $messages{'en'} if ($lang ne 'en') ;
=head2 Replacement of [= foo =] through the matching text, as far as available
=head2 $r -> gettext('foo') to get the matching text
=head1 Future...
=head2 There are many more possibilities of Embperl, for example session-handling
and form validation
=head2 2.0b8 is the last beta, which is already quite stable
=head2 Final release of 2.0 is planed for the next three month.
=head2 Main addition will be documentation improvements and threads to use the full
power of mod_perl 2 in threaded mode.
=head2 More informations can be found on the Embperl Web Site
http://perl.apache.org/embperl/
http://www.ecos.de/embperl/