view release on metacpan or search on metacpan
examples/edit.ep Generic script for editing DBI tables
examples/pop3/delete.ep POP3 Client (Deleting a mail)
examples/pop3/index.ep POP3 Client (Welcome page)
examples/pop3/list.ep POP3 Client (Mailbox list)
examples/pop3/reply.ep POP3 Client (Replying a mail)
examples/pop3/send.ep POP3 Client (Sending a mail)
examples/pop3/show.ep POP3 Client (Mail display)
examples/shop/README Shopping cart (Docs)
examples/shop/admin/index.ep Shopping cart (Main administration page)
examples/shop/admin/download.ep Shopping cart (Download page)
examples/shop/admin/prefs.ep Shopping cart (Preferences)
examples/shop/admin/upload.ep Shopping cart (Upload page)
html/test.ep
html/de.jpg
html/en.jpg
examples/admin/mail2group view on Meta::CPAN
require Mail::Internet;
require Mail::Util;
require Getopt::Long;
require Time::Local;
require DBI;
require Data::Dumper;
require Symbol;
my $PREFS_FILE = '/home/httpd/html/admin/var/prefs';
my $SPOOL_DIR = '/var/spool/mail';
my $DBI_DSN = 'DBI:mysql:user';
my $DBI_USER = 'nobody';
#my $DBI_PASS = '';
my $DBI_PASS = 'my_name_is_nobody';
my $WWW_USER = 'nobody';
#my $LOCAL_MAILS = '\@euwid\.de\b';
my $LOCAL_MAILS = '';
my %MONTHS = (
examples/admin/mail2group view on Meta::CPAN
Getopt::Long::GetOptions($options, 'dsn=s', 'user=s', 'password=s',
'verbose', 'debug');
my $debug = $options->{'debug'};
if ($debug) {
$options->{'verbose'} = 1;
}
my $verbose = $options->{'verbose'};
my $config = do $PREFS_FILE
|| die "Error while reading prefs file $PREFS_FILE: $@";
if (!$config->{'mail2group'}->{'active'}) { exit 0 }
if (!$config->{'mail2group'}->{'weekend'}) {
my($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time());
if ($wday == 0 || $wday == 6) { exit 0 }
}
my $cache = $config->{'mail2group'}->{'cache'} or {};
foreach my $var (keys %$cache) {
$cache->{$var} = 0;
examples/admin/mail2group.ep view on Meta::CPAN
<ep-package name="HTML::EP::Locale">
<ep-perl>
my $self = $_;
my $prefs_file = $self->{'env'}->{'PATH_TRANSLATED'};
$prefs_file =~ s/(.*)\/.*/$1/;
$prefs_file .= "/var/prefs";
if ($self->{'debug'}) {
$self->print("Setting preferences file to $prefs_file\n");
}
$self->{'config'} = do $prefs_file || {};
if ($@) {
$self->{'warnings'} = "Couldn't read prefs file $prefs_file: $@";
}
my $cgi = $self->{'cgi'};
if (defined($cgi->param('mail2group_active'))) {
# Save data
my $o = $self->{'config'}->{'mail2group'} || {};
$o->{'active'} = ($cgi->param('mail2group_active') ? 1 : 0);
$o->{'weekend'} = ($cgi->param('mail2group_weekend') ? 1 : 0);
$o->{'delay'} = $cgi->param('mail2group_delay');
$self->{'config'}->{'mail2group'} = $o;
require Data::Dumper;
my $dump = Data::Dumper->new([$self->{'config'}], ['PREFS']);
$dump->Indent(1);
require Symbol;
my $fh = Symbol::gensym();
if ($self->{'debug'}) {
$self->print("Saving data:\n", $dump->Dump(), "\n");
}
if (!open($fh, ">$prefs_file") || !(print $fh $dump->Dump()) ||
!close($fh)) {
$self->{'errors'} = "Couldn't save data: $!";
}
}
package HTML::EP::Locale;
sub _format_SELECTED {
my $self = shift; my $option = shift;
$option ? " SELECTED" : "";
};
examples/shop/README view on Meta::CPAN
the WWW user.
- Prevent WWW access to this directory, for example by inserting a
.htaccess file like
order allow,deny
deny from all
- Create the CSV files you need, for example
dbimon DBI:CSV:f_dir=/home/httpd/html/outdoor/shop
dbimon> CREATE TABLE prefs (var VARCHAR(64), val BLOB)
dbimon> CREATE TABLE articles (
id VARCHAR(64),
Artikel VARCHAR(64),
Marke VARCHAR(64),
Modell VARCHAR(64),
Farbe VARCHAR(64),
Groesse VARCHAR(64),
Menge VARCHAR(64),
Preis VARCHAR(64),
BestellNr VARCHAR(64),
examples/shop/admin/index.ep view on Meta::CPAN
<A HREF="index.ep?language=en">
<IMG SRC=/outdoor/en.jpg ALT=English BORDER=0></A>
</DIV>
<BR><BR><BR>
<H1><ep-language de="Administration" en="Administration"></H1>
<p>
<ep-language language="de">
Hier findet die Verwaltung Ihres Shops statt. Die folgenden Möglichkeiten
werden Ihnen angeboten:
<ul>
<li><a href="prefs.ep?language=$_ep_language$">Pflege der Stammdaten</a>
<li><a href="#upload">Einspeisen neuer Daten</a>
<li><a href="#download">Download der derzeit aktuellen Daten</a>
</ul>
</ep-language>
<ep-language language="en">
This is the administration page of your shop. The following possibilities
are avilable:
<ul>
<li><a href="prefs.ep?language=$_ep_language$">Edit the preferences</a>
<li><a href="#upload">Upload new data</a>
<li><a href="#download">Download the current data</a>
</ul>
</ep-language>
</p>
<a name="upload">
<h2><ep-language de="Upload" en="Upload"></h2>
<DIV ALIGN=CENTER>
<FORM ACTION="upload.ep" METHOD=POST ENCTYPE="multipart/form-data">
examples/shop/admin/prefs.ep view on Meta::CPAN
<ep-package name="HTML::EP::Shop">
<ep-database dsn="DBI:CSV:f_dir=$env->DOCUMENT_ROOT$/outdoor/shop/var">
<ep-shop-prefs-read var="prefs" write=1>
<HTML><HEAD><TITLE>
<ep-language de="Stammdaten" en="Preferences"></TITLE></HEAD>
<BODY BGCOLOR="#FFFFFF">
<H1><ep-language de="Stammdaten" en="Preferences"></H1>
<FORM ACTION="prefs.ep" METHOD=POST>
<INPUT TYPE=hidden NAME=language VALUE="$_ep_language$">
<H2><ep-language de="Firmenstammdaten" en="Company data"></H2>
<DIV ALIGN=CENTER>
<TABLE>
<TR><TH><ep-language de="Firma" en="Company">:</TH>
<TD><INPUT SIZE=30 NAME="prefs_company" VALUE="$prefs->company$"></TD>
</TR>
<TR><TH> </TH>
<TD><INPUT SIZE=30 NAME="prefs_name" VALUE="$prefs->name$"></TD>
</TR>
<TR><TH><ep-language de="Straße" en="Street address">:</TH>
<TD><INPUT SIZE=30 NAME="prefs_street" VALUE="$prefs->street$"></TD>
</TR>
<TR><TH><ep-language de="PLZ, Ort" en="ZIP, City">:</TH>
<TD><INPUT SIZE=5 NAME="prefs_zip" VALUE="$prefs->zip$">
<INPUT SIZE=25 NAME="prefs_city" VALUE="$prefs->city$"></TD>
</TR>
<TR><TH><ep-language de="Land" en="Country">:</TH>
<TD><INPUT SIZE=30 NAME="prefs_country" VALUE="$prefs->country$"></TD>
</TR>
<TR><TH><ep-language de="Telefon" en="Phone">:</TH>
<TD><INPUT SIZE=30 NAME="prefs_phone" VALUE="$prefs->phone$"></TD>
</TR>
<TR><TH><ep-language de="Telefax" en="Fax">:</TH>
<TD><INPUT SIZE=30 NAME="prefs_fax" VALUE="$prefs->fax$"></TD>
</TR>
<TR><TH><ep-language de="Email" en="Email">:</TH>
<TD><INPUT SIZE=30 NAME="prefs_email" VALUE="$prefs->email$"></TD>
</TR>
</TABLE>
</DIV>
<H2><ep-language de="Rechnungsdaten" en="Bill related data"></H2>
<DIV ALIGN=CENTER>
<TABLE>
<TR><TH><ep-language de="MwSt." en="VAT">:</TH>
<TD><INPUT SIZE=5 NAME="prefs_vat" VALUE="$prefs->vat$"></TD>
</TR>
<TR><TH><ep-language de="Kreditkarten" en="Credit Cards">:</TH>
<TD><INPUT SIZE=30 NAME="prefs_creditcards" VALUE="$prefs->creditcards$">
</TD>
</TR>
<TR><TD COLSPAN=2>
<FONT SIZE=-1>
<ep-language language="en">
Comma separated list of values; leave blank if you don't
want to accept credit cards. <B>Caveat:</B> Sending credit
card data via the Internet has security problems unless you
are using an HTTPS server.
</ep-language>
examples/shop/admin/prefs.ep view on Meta::CPAN
Durch Kommata getrennte Liste von Namen; leer lassen, falls
Bestellung per Kreditkarte unerwünscht. <B>Vorsicht:</B>
Der Versand von Kreditkartendaten durch das Internet ist ein
potentielles Sicherheitsproblem, sofern kein HTTPS-Server
verwendet wird.
</ep-language>
</FONT></TD>
</TR>
<TR><TH><ep-language de="Versand per Nachnahme"
en="Versand per Nachnahme"></TH>
<TD><SELECT NAME="prefs_nachnahme">
<ep-if eval="$prefs->nachnahme$">
<OPTION VALUE=1 SELECTED><ep-language de="Ja" en="Yes">
<OPTION VALUE=0><ep-language de="Nein" en="No">
<ep-else>
<OPTION VALUE=1><ep-language de="Ja" en="Yes">
<OPTION VALUE=0 SELECTED><ep-language de="Nein" en="No">
</ep-if>
</SELECT></TD>
</TR>
<ep-language language="en">
<TR><TD COLSPAN=2>
<FONT SIZE=-1>(English translation missing here, thanks for
any input!)</FONT></TD>
</TR>
</ep-language>
<TR><TH><ep-language de="Versand per Rechnung"
en="Versand per Rechnung"></TH>
<TD><SELECT NAME="prefs_rechnung">
<ep-if eval="$prefs->rechnung$">
<OPTION VALUE=1 SELECTED><ep-language de="Ja" en="Yes">
<OPTION VALUE=0><ep-language de="Nein" en="No">
<ep-else>
<OPTION VALUE=1><ep-language de="Ja" en="Yes">
<OPTION VALUE=0 SELECTED><ep-language de="Nein" en="No">
</ep-if>
</SELECT></TD>
</TR>
<ep-language language="en">
<TR><TD COLSPAN=2>
<FONT SIZE=-1>(English translation missing here, thanks for
any input!)</FONT></TD>
</TR>
</ep-language>
<TR><TH><ep-language de="Versand per Lastschrift"
en="Versand per Lastschrift"></TH>
<TD><SELECT NAME="prefs_lastschrift">
<ep-if eval="$prefs->lastschrift$">
<OPTION VALUE=1 SELECTED><ep-language de="Ja" en="Yes">
<OPTION VALUE=0><ep-language de="Nein" en="No">
<ep-else>
<OPTION VALUE=1><ep-language de="Ja" en="Yes">
<OPTION VALUE=0 SELECTED><ep-language de="Nein" en="No">
</ep-if>
</SELECT></TD>
</TR>
<ep-language language="en">
<TR><TD COLSPAN=2>
lib/HTML/EP/Examples/Admin.pm view on Meta::CPAN
my $self = shift;
if (!exists($self->{'admin_config'})) {
$self->SUPER::init();
$self->{'admin_config'} =
$self->{'_ep_config'}->{'examples'}->{'admin'} || {};
$self->{'admin_config'}->{'vardir'} ||= '/home/httpd/html/admin/var';
}
}
sub _prefs {
my $self = shift; my $prefs = shift;
my $vardir = $self->{'admin_config'}->{'vardir'};
my $prefs_file = "$vardir/prefs";
if (!$prefs) {
# Load Prefs
$self->{'prefs'} = (do $prefs_file) || {};
} else {
# Save Prefs
require Data::Dumper;
my $dump = Data::Dumper->new([$prefs], ['PREFS']);
$dump->Indent(1);
require Symbol;
my $fh = Symbol::gensym();
my $d = $dump->Dump();
if ($self->{'debug'}) {
print "Saving Preferences to $prefs_file.\n";
$self->print("Saving data:\n$d\n");
}
if (!open($fh, ">$prefs_file")
or !(print $fh "$d\n")
or !close($fh)) {
die "Couldn't save data: $!";
}
$self->{'prefs'} = $prefs;
}
}
sub _ep_html_ep_examples_admin_squid {
my $self = shift; my $attr = shift;
my $cgi = $self->{'cgi'};
my $prefs = $self->_prefs();
my $debug = $self->{'debug'};
my $verify_squid_range = sub {
my($from, $to, $active, $name) = @_;
require Socket;
my($f, $t);
if (!($f = Socket::inet_aton($from))) {
die "Invalid IP address: $from";
}
lib/HTML/EP/Examples/Admin.pm view on Meta::CPAN
last;
}
push(@range,
&$verify_squid_range($from, $to, $cgi->param("edit_active_$i"),
$cgi->param("edit_name_$i")));
$modified = 1;
}
if ($modified) {
$self->print("Modifications detected.\n") if $debug;
$prefs->{'squid_ranges'} = \@range;
$self->_prefs($prefs);
my $path_users_modified =
($attr->{'users-modified-path'} ||
$self->{'admin_config'}->{'users_modified_path'})
or die "Path of usersModified binary not set";
if ($path_users_modified ne 'none') {
die "No such binary: $path_users_modified"
unless -f $path_users_modified;
my @command = ($path_users_modified, '--squid');
foreach my $r (@range) {
next unless $r->{'active'};
push(@command,
"--range", "$r->{'from'},$r->{'to'},$r->{'name'}");
}
$self->print("Executing command: ", join(" ", @command), "\n")
if $debug;
system @command;
}
} else {
$self->print("No modifications detected.\n") if $debug;
$prefs->{'squid_ranges'} ||= [];
}
@range = sort { $a->{name} cmp $b->{name}} @{$prefs->{'squid_ranges'}};
$self->{'ranges'} = \@range;
if ($debug) {
$self->print("Squid IP ranges:\n");
foreach my $r (@{$prefs->{'squid_ranges'}}) {
$self->printf(" Name %s, From %s, To %s, Active %s\n",
$r->{'name'}, $r->{'from'}, $r->{'to'},
$r->{'active'});
}
}
$self->{'admin_config'}->{'squid_conf_path'} ||= '/etc/squid.conf';
'';
}
lib/HTML/EP/Session.pm view on Meta::CPAN
which implement one session per user. I enjoy using the Dumper
subclass anyways, for example to implement site wide preferences.
What the class does is creating a file which holds a single
hash ref. This hash ref is created using the I<Data::Dumper>
package. L<Data::Dumper(3)>.
You create a Dumper session like this:
<ep-session class="HTML::EP::Session::Dumper"
id="/var/tmp/my.session" var="prefs">
In other words, the session ID is just the name of the file.
=head1 MULTIPLE SESSION
When looking at the Cookie and Dumper subclass, the question arises:
Can I use multiple sessions within a single HTML page? Of course you
can!
lib/HTML/EP/Shop.pm view on Meta::CPAN
$ref = \@row;
}
$csv->print($self, $ref);
}
$self->Stop();
'';
}
sub _ep_shop_prefs_write {
my $self = shift; my $attr = shift;
my $table = $attr->{'table'} || 'prefs';
my $pvar = $attr->{'var'} || 'prefs';
my $prefs = $self->{$pvar} || die "No prefs set in variable $pvar";
my $tvar = $attr->{'tvar'} || 'prefs';
my $dbh = $self->{'dbh'} || die "Missing database handle";
if ($self->{'debug'}) {
$self->print("Saving prefs: ", join(" ", %$prefs), "\n");
}
my $uquery = "UPDATE $table SET val = ? WHERE var = "
. $dbh->quote($tvar);
my $freezed_prefs = Storable::nfreeze($prefs);
eval {$dbh->do($uquery, undef, $freezed_prefs) };
if ($@) {
my $error = $@;
my $cquery = "CREATE TABLE $table ("
. " var VARCHAR(32) NOT NULL,"
. " val BLOB NOT NULL)";
if (eval { $dbh->do($cquery) }) {
$cquery = "INSERT INTO $table VALUES (" . $dbh->quote($tvar)
. ", ?)";
eval { $dbh->do($cquery, undef, $freezed_prefs) };
}
if ($@) {
die "While updating: Catched error\n$error\n" .
"Update query was: $uquery\n" .
"While inserting: Catched error\n$@\n" .
"Insert query was: $cquery\n";
}
}
'';
}
sub _ep_shop_prefs_read {
my $self = shift; my $attr = shift;
my $cgi = $self->{'cgi'};
my $dbh = $self->{'dbh'};
my $table = $self->{'table'} || 'prefs';
my $pvar = $attr->{'var'} || 'prefs';
my $tvar = $attr->{'tvar'} || 'prefs';
my $prefs = $self->{$pvar};
# Read Prefs
if (!$prefs) {
my $ref;
eval {
my $sth = $dbh->prepare("SELECT val FROM prefs WHERE var = ?");
$sth->execute($tvar);
$ref = $sth->fetchrow_arrayref();
};
$prefs = $ref ? Storable::thaw($ref->[0]) : {};
}
$self->{$pvar} = $prefs;
if ($attr->{'write'} && defined($cgi->{'prefs_company'})) {
# Save Prefs
foreach my $var ($cgi->param()) {
if ($var =~ /^prefs_(.*)/) {
$prefs->{$1} = $cgi->param($var);
}
}
$self->_ep_shop_prefs_write($attr);
}
'';
}
1;
__END__
print("Expected $b, got $a\n");
}
$c;
}
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = '';
unlink "prefs";
my $input = q{
<ep-package name="HTML::EP::Shop">
<ep-database dsn="DBI:CSV:">
<ep-shop-prefs-read var="prefs" write=1>
$prefs->company$,$prefs->street$,$prefs->zip$,$prefs->city$,$prefs->country$
$prefs->vat$,$prefs->creditcards$,$prefs->nachnahme$,$prefs->rechnung$
$prefs->lastschrift$
};
my $output = q{
,,,,
,,,
};
my $parser = HTML::EP->new();
$parser->{'env'} = { 'PATH_TRANSLATED' => 't/shop.t'};
Test2($parser->Run($input), $output, "Reading the prefs (initially).\n");
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'prefs_company=ISPsoft&prefs_street=Am+Eisteich+9'
. '&prefs_zip=72555&prefs_city=Metzingen&prefs_country=Deutschland'
. '&prefs_vat=16.0&prefs_creditcards=Mastercard,Eurocard,VISA'
. '&prefs_nachnahme=1&prefs_rechnung=1&prefs_lastschrift=1';
$input = q{
<ep-package name="HTML::EP::Shop">
<ep-database dsn="DBI:CSV:">
<ep-shop-prefs-read var="prefs" write=1>
$prefs->company$,$prefs->street$,$prefs->zip$,$prefs->city$,$prefs->country$
$prefs->vat$,$prefs->creditcards$,$prefs->nachnahme$,$prefs->rechnung$
$prefs->lastschrift$
};
$output = q{
ISPsoft,Am Eisteich 9,72555,Metzingen,Deutschland
16.0,Mastercard,Eurocard,VISA,1,1
1
};
$parser = HTML::EP->new();
$parser->{'env'} = { 'PATH_TRANSLATED' => 't/shop.t'};
Test2($parser->Run($input), $output, "Writing the prefs (initially).\n");
$input = q{
<ep-package name="HTML::EP::Shop">
<ep-database dsn="DBI:CSV:">
<ep-shop-prefs-read var="prefs">
$prefs->company$,$prefs->street$,$prefs->zip$,$prefs->city$,$prefs->country$
$prefs->vat$,$prefs->creditcards$,$prefs->nachnahme$,$prefs->rechnung$
$prefs->lastschrift$
};
$output = q{
ISPsoft,Am Eisteich 9,72555,Metzingen,Deutschland
16.0,Mastercard,Eurocard,VISA,1,1
1
};
$parser = HTML::EP->new();
$parser->{'env'} = { 'PATH_TRANSLATED' => 't/shop.t'};
Test2($parser->Run($input), $output, "Reading the prefs again.\n");
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'prefs_company=ISPsoft&prefs_street=Am+Eisteich+9'
. '&prefs_zip=72555&prefs_city=Metzingen&prefs_country=Deutschland'
. '&prefs_vat=17.0'
. '&prefs_creditcards=Mastercard,Eurocard,VISA,American+Express'
. '&prefs_nachnahme=1&prefs_rechnung=1&prefs_lastschrift=1';
# Prevent CGI module from caching
undef @CGI::QUERY_PARAM;
undef @CGI::QUERY_PARAM; # -w
$input = q{
<ep-package name="HTML::EP::Shop">
<ep-database dsn="DBI:CSV:">
<ep-shop-prefs-read var="prefs" write=1>
$prefs->company$,$prefs->street$,$prefs->zip$,$prefs->city$,$prefs->country$
$prefs->vat$,$prefs->creditcards$,$prefs->nachnahme$,$prefs->rechnung$
$prefs->lastschrift$
};
$output = q{
ISPsoft,Am Eisteich 9,72555,Metzingen,Deutschland
17.0,Mastercard,Eurocard,VISA,American Express,1,1
1
};
$parser = HTML::EP->new();
$parser->{'env'} = { 'PATH_TRANSLATED' => 't/shop.t'};
Test2($parser->Run($input), $output, "Updating the prefs.\n");
$input = q{
<ep-package name="HTML::EP::Shop">
<ep-database dsn="DBI:CSV:">
<ep-shop-prefs-read var="prefs">
$prefs->company$,$prefs->street$,$prefs->zip$,$prefs->city$,$prefs->country$
$prefs->vat$,$prefs->creditcards$,$prefs->nachnahme$,$prefs->rechnung$
$prefs->lastschrift$
};
$output = q{
ISPsoft,Am Eisteich 9,72555,Metzingen,Deutschland
17.0,Mastercard,Eurocard,VISA,American Express,1,1
1
};
$parser = HTML::EP->new();
$parser->{'env'} = { 'PATH_TRANSLATED' => 't/shop.t'};
Test2($parser->Run($input), $output, "Reading the prefs (finally).\n");
unlink 'prefs';