HTML-EP

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

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>&nbsp;</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__

t/shop.t  view on Meta::CPAN

	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';






( run in 1.984 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )