View of /DadaFork/DADA/Template/HTML.pm
Parent Directory
| 
Revision Log
Revision:
2253 -
(
download)
Wed Jan 10 14:34:26 2007 UTC (17 years, 3 months ago) by
pje
File size: 17845 byte(s)
Base version: DadaMail 2.10.12
package DADA::Template::HTML;
use lib qw(./ ../);
use DADA::Config qw(!:DEFAULT);
use DADA::App::Guts;
my $Yeah_Root_Login = 0;
use Fcntl qw(
O_WRONLY
O_TRUNC
O_CREAT
O_RDWR
O_RDONLY
LOCK_EX
LOCK_SH
LOCK_NB
);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
admin_html_header
admin_html_footer
default_template
check_if_template_exists
available_templates
open_template
the_html
submit_form
archive_send_form
make_feature_menu
default_css
admin_header_params
);
use strict;
use vars qw(@EXPORT);
use CGI;
my $q = CGI->new;
$q->param('flavor', $q->param('f'))
if ! defined($q->param('flavor'));
=pod
=head1 NAME
DADA::Template::HTML
=head1 SYNOPSIS
Module for generating HTML templates for lists and administration
=head2 DESCRIPTION
use DADA::Template::HTML;
#print out a admin header template:
print admin_html_header(-Title => "hola! I am a list header",
-List => $list,
);
# now, print the admin footer template:
print admin_html_footer(-List => $list);
# give me the default Dada Mail list template
my $default_template = default_template($DADA::Config::PROGRAM_URL);
# do I have a template?
my $template_exists = check_if_template_exists(-List => $list);
print "my template exists!!" if $template_exists >= 1;
# what lists do have templates?
my @list_templates = available_templates();
# open up my template
my $list_template = open_template(-List => $list);
# print a list template header
print the_html(-List => $list,
-Path => 'header',
);
# print the list template footer
print the_html(-List => $list,
-Path => 'footer',
-Site_Name => "justin's site",
-Site_URL => "http://skazat.com",
);
# print a generic submit form
print submit_form(-Submit => 'ZOOOOOOOOOM!',
-Reset => 'stop.',
-Align => 'left',
-Width => '100%'
);
# the 'send this archived message to a friend" link maker
# print archive_send_link($list, $message_id);
=cut
#HTML Templates for Dada Mail
sub admin_html_header {
my %args = (-Title => "",
-List => "",
-Root_Login => 0,
-Form => 1,
-li => undef,
-HTML_Header => 1,
@_);
# This is horrible.
$Yeah_Root_Login = 1
if $args{-Root_Login} == 1;
require DADA::Template::Widgets::Admin_Menu;
my $admin_menu;
my $li;
if(!$args{-li}){
require DADA::MailingList::Settings;
my $ls = DADA::MailingList::Settings->new(-List => $args{-List});
$li = $ls->get;
}else{
$li = $args{-li};
}
if($Yeah_Root_Login == 1){
$admin_menu = DADA::Template::Widgets::Admin_Menu::make_admin_menu('superuser');
}else{
$admin_menu = DADA::Template::Widgets::Admin_Menu::make_admin_menu('user', $li);
}
my $title = $args{-Title};
my $list = $args{-List};
my $root_login_message = '';
if($args{-Root_Login} == 1){
$root_login_message = '<span id="root_login_message">Logged In as Root</span>';
}
my $header_part;
if($DADA::Config::ADMIN_TEMPLATE){
my ($saved_header, $saved_footer) = fetch_admin_template($DADA::Config::ADMIN_TEMPLATE);
$header_part = $saved_header;
}else{
require DADA::Template::Widgets;
my ($a_h, $a_f) = split(/\[content\]/, DADA::Template::Widgets::screen(-screen => 'default_admin_template.tmpl'));
$header_part = $a_h;
}
my $login_switch_widget = '';
if($Yeah_Root_Login){
require DADA::Template::Widgets;
$login_switch_widget = DADA::Template::Widgets::login_switch_widget({-list => $args{-List}, ($q->param('flavor') ? (-f => $q->param('flavor')) : ())});
}
$header_part = $header_part . qq{<form action="[s_program_url]" method="post" name="default_form"> }
unless $args{-Form} == 0;
my $js = admin_js();
$header_part =~ s/\[login_switch_widget\]/$login_switch_widget/g;
$header_part =~ s/<\!--\[javascript\]-->/$js/g;
$header_part =~ s/\[javascript\]/$js/g;
$header_part =~ s/\[admin_menu\]/$admin_menu /g;
$header_part =~ s/\[title\]/$title/g;
$header_part =~ s/\[list\]/$list/g;
$header_part =~ s/\[list_name\]/$li->{list_name}/g;
$header_part =~ s/\[ver\]/$DADA::Config::VER/g;
$header_part =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g;
$header_part =~ s/\[s_program_url\]/$DADA::Config::S_PROGRAM_URL/g;
$header_part =~ s/\[root_login_message\]/$root_login_message/g;
$header_part =~ s/\[program_name\]/$DADA::Config::PROGRAM_NAME/g;
if($args{-HTML_Header} == 1){
$header_part = $q->header(
admin_header_params(),
) . $header_part;
}
return $header_part;
}
sub admin_header_params {
my %params = (
-type => 'text/html',
-charset => $DADA::Config::HTML_CHARSET,
-Pragma => 'no-cache',
'-Cache-control' => 'no-cache, must-revalidate',
);
return %params;
}
#############################################################################
# holds the default admin template. footer #
#############################################################################
sub admin_html_footer {
my %args = (-Form => 1, -Root_Login => 0, -List => '', -li => undef, @_);
my $footer_part;
# This is horrible.
$Yeah_Root_Login = 1
if $args{-Root_Login} == 1;
require DADA::Template::Widgets::Admin_Menu;
my $admin_menu;
my $li;
if(!$args{-li}){
require DADA::MailingList::Settings;
my $ls = DADA::MailingList::Settings->new(-List => $args{-List});
$li = $ls->get;
}else{
$li = $args{-li};
}
if($Yeah_Root_Login == 1){
$admin_menu = DADA::Template::Widgets::Admin_Menu::make_admin_menu('superuser', $li);
}else{
$admin_menu = DADA::Template::Widgets::Admin_Menu::make_admin_menu('user', $li);
}
if($DADA::Config::ADMIN_TEMPLATE){
my ($saved_header, $saved_footer) = fetch_admin_template($DADA::Config::ADMIN_TEMPLATE);
$footer_part = $saved_footer;
}else{
require DADA::Template::Widgets;
my ($a_h, $a_f) = split(/\[content\]/, DADA::Template::Widgets::screen(-screen => 'default_admin_template.tmpl'));
$footer_part = $a_f;
}
my $login_switch_widget = '';
if($Yeah_Root_Login){
require DADA::Template::Widgets;
$login_switch_widget = DADA::Template::Widgets::login_switch_widget({-list => $args{-List}, ($q->param('flavor') ? (-f => $q->param('flavor')) : ())});
}
$footer_part =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g;
$footer_part =~ s/\[s_program_url\]/$DADA::Config::S_PROGRAM_URL/g;
$footer_part =~ s/\[login_switch_widget\]/$login_switch_widget/g;
$footer_part =~ s/\[admin_menu\]/$admin_menu /g;
$footer_part =~ s/\[list_name\]/$li->{list_name}/g;
$footer_part =~ s/\[list\]/$args{-List}/g;
$footer_part = '</form> ' . $footer_part unless $args{-Form} == 0;
return $footer_part;
}
sub default_template {
if(!$DADA::Config::USER_TEMPLATE){
require DADA::Template::Widgets;
my $default_template = DADA::Template::Widgets::screen(-screen => 'default_list_template.tmpl');
return $default_template;
}else{
if($DADA::Config::USER_TEMPLATE =~ m/^http/){
return open_template_from_url(-URL => $DADA::Config::USER_TEMPLATE);
}else{
return fetch_user_template($DADA::Config::USER_TEMPLATE);
}
}
}
######################################################################
# templates and such that give the look of dada #
######################################################################
sub check_if_template_exists {
#############################################################################
# dadautility <+> $template_exists <+> sees if the list has a template #
#############################################################################
my %args = (-List => undef,
@_);
if($args{-List}){
my(@available_templates) = &available_templates;
my $template_exists = 0;
foreach my $hopefuls(@available_templates) {
if ($hopefuls eq $args{-List}) {
$template_exists++;
}
}
return $template_exists;
}else{
return 0;
}
}
sub available_templates {
my @all;
my @available_templates;
my $present_template = "";
opendir(TEMPLATES, $DADA::Config::TEMPLATES ) or
die "$DADA::Config::PROGRAM_NAME $DADA::Config::VER error, can't open $DADA::Config::TEMPLATES to read: $!";
while(defined($present_template = readdir TEMPLATES)) {
next if $present_template =~ /^\.\.?$/;
$present_template =~ s(^.*/)();
push(@all, $present_template);
}
closedir(TEMPLATES);
foreach my $all_those(@all) {
if($all_those =~ m/.*\.template/) {
$all_those =~ s/\.template$//;
push(@available_templates, $all_those)
}
}
@available_templates = sort(@available_templates);
my %seen = ();
my @unique = grep {! $seen{$_} ++ } @available_templates;
return @unique;
}
sub fetch_admin_template {
my $file = shift;
my $list_template;
if($file =~ m/^http/){
$list_template = open_template_from_url(-URL => $file);
}else{
if($file !~ m/^\//){
$file = $DADA::Config::TEMPLATES .'/'. $file;
}
sysopen(TEMPLATE,"$file", O_RDONLY|O_CREAT, $DADA::Config::FILE_CHMOD ) or
die "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: Can't open list template for reading at '$file': $!";
flock(TEMPLATE, LOCK_SH) or
warn "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: Can't create a shared lock for template file at '$file': $!";
$list_template = do{ local $/; <TEMPLATE> };
close (TEMPLATE);
}
my ($header, $footer) = split(/\[content\]/, $list_template);
return($header, $footer);
}
sub fetch_user_template {
my $file = shift;
my $list_template;
sysopen(TEMPLATE,"$file", O_RDONLY|O_CREAT, $DADA::Config::FILE_CHMOD ) or
die "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: Can't open list template for reading at '$file': $!";
flock(TEMPLATE, LOCK_SH) or
warn "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: Can't create a shared lock for template file at '$file': $!";
$list_template= do{ local $/; <TEMPLATE> };
close (TEMPLATE);
return $list_template;
}
sub open_template {
my %args = (-List => undef,
@_);
my $list = $args{-List};
my $templatefile = make_safer($DADA::Config::TEMPLATES . '/' . $list . '.template');
my $list_template = "";
my @template;
sysopen(TEMPLATE, $templatefile, O_RDWR|O_CREAT, $DADA::Config::FILE_CHMOD ) or
die "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: Can't open list template for reading at '$templatefile': $!";
flock(TEMPLATE, LOCK_SH) or
warn "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: Can't create a shared lock for template file at '$templatefile': $!";
@template = <TEMPLATE>;
close (TEMPLATE);
foreach(@template){
$list_template .= $_;
}
return $list_template;
}
sub the_html {
my %args = (-List => undef,
-Part => undef,
-Title => undef,
-Site_Name => "",
-Site_URL => "",
-Start_Form => 1,
-End_Form => 1,
-Header => 1,
-header_params => {},
@_);
$args{-List} =~ s/ /_/i if $args{-List}; # HACK DEV This is old code, put in here where listshortnames were the same as list names and both
# could have spaces in the names. This should be looked at, removed and tested soon.
if($DADA::Config::PROGRAM_URL eq 'http://www.changetoyoursite.com/cgi-bin/dada/mail.cgi'){
$DADA::Config::PROGRAM_URL = $ENV{SCRIPT_URI} || $q->url();
}
my $default_template = default_template($DADA::Config::PROGRAM_URL);
my $template_exists = check_if_template_exists(-List => $args{-List});
my $the_header = "";
my $the_footer = "";
my $li = {};
if($args{-List}){
require DADA::MailingList::Settings;
my $ls = DADA::MailingList::Settings->new(-List => $args{-List});
$li = $ls->get;
}
if(exists($li->{list})){
if($li->{get_template_data} eq "from_url" && $li->{url_template} =~ m/^http:\/\//){
my $list_template = open_template_from_url(-List => $args{-List},
-URL => $li->{url_template});
($the_header, $the_footer) = split(/\[dada\]|\[mojo\]/,$list_template);
}elsif($li->{get_template_data} eq 'from_default_template'){
($the_header, $the_footer) = split(/\[dada\]|\[mojo\]/,$default_template);
}elsif($template_exists >= 1) {
my $list_template = open_template(-List => $args{-List});
($the_header, $the_footer) = split(/\[dada\]|\[mojo\]/,$list_template);
} else {
($the_header, $the_footer) = split(/\[dada\]|\[mojo\]/,$default_template);
}
}else{
($the_header, $the_footer) = split(/\[dada\]|\[mojo\]/,$default_template);
}
if($args{-Part} eq "header") {
if($li->{show_archives} &&
$li->{publish_archives_rss}
){
my $rss_link = q{
<link rel="alternate" type="application/rss+xml" title="RSS" href="[program_url]/archive_rss/[list]/" />
<link rel="alternate" type="application/atom+xml" title="Atom" href="[program_url]/archive_atom/[list]/" />
};
$the_header =~ s/<\/head>/\n\n $rss_link\n\n<\/head>/i;
}
my $default_css = default_css();
$the_header =~ s/<\!--\[default_css\]-->/$default_css/g;
$the_header =~ s/\[default_css\]/$default_css/g;
$the_header =~ s/\[message\]/$args{-Title}/g;
$the_header =~ s/\[list\]/$args{-List}/g;
$the_header =~ s/\[version\]/$DADA::Config::VER/g;
$the_header =~ s/\[program_name\]/$DADA::Config::PROGRAM_NAME/g;
$the_header =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g;
$the_header .= "\n<form action=\"$DADA::Config::PROGRAM_URL\" method=\"post\">\n" if $args{-Start_Form} != 0;
if($args{-Header} == 1){
return $q->header(-type => 'text/html; ' . $DADA::Config::HTML_CHARSET, %{$args{-header_params}}) . $the_header;
}else{
$the_header;
}
}else{
$the_footer = "\n$DADA::Config::HTML_FOOTER \n" . $the_footer . "\n";
if($args{-Site_Name} && $args{-Site_URL}) {
$the_footer = '<p>Go back to <a href="' . $args{-Site_URL} . '">' . $args{-Site_Name} . '</a></p>' . $the_footer;
}
$the_footer =~ s/\[message\]/$args{-Title}/g;
$the_footer =~ s/\[list\]/$args{-List}/g;
$the_footer =~ s/\[version\]/$DADA::Config::VER/g;
$the_footer =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g;
$the_footer = '</form> ' . $the_footer if $args{-End_Form} != 0;
return $the_footer;
}
}
sub open_template_from_url {
my %args = (-List => undef,
-URL => undef,
@_);
if(!$args{-URL}){
warn "no url passed! $!";
return undef;
}else{
eval { require LWP::Simple };
if($@){
warn "LWP::Simple not installed! $!";
return undef;
}else{
return LWP::Simple::get($args{-URL});
}
}
}
sub submit_form{
my %args = (-Reset => 'Clear Changes',
-Submit => 'Save Changes',
-Align => 'right',
-Width => '',
@_);
my $form = <<EOF
<table width=$args{-Width} align=$args{-Align}>
<tr>
<td><input type="reset" class="cautionary" value="$args{-Reset}" /></td>
<td><input type="submit" class="processing" value="$args{-Submit}" /></td>
</tr>
</table>
EOF
;
return $form;
}
sub archive_send_form {
my ($list, $id, $errors) = @_;
my $error_msg = ' ';
$error_msg = qq{<p class="error"><strong>This form was filled out incorrectly.</strong></p>} if $errors > 0;
my $form = <<EOF
$error_msg
<h3>
Send this message to a friend:
</h3>
<form action="$DADA::Config::PROGRAM_URL" method="post">
<input type="hidden" name="list" value="$list" />
<input type="hidden" name="entry" value="$id" />
<input type="hidden" name="flavor" value="send_archive" />
<input type="hidden" name="process" value="true" />
<p>
<label for="sender_email">
Your email address:
</label>
<br />
<input type="text" name="sender_email" id="sender_email" maxlength="1024" />
</p>
<p>
<label for="email">
Your friend's email address:
</label>
<br />
<input type="text" name="email" id="email" maxlength="1024" />
</p>
<p>
<label for="note">
Note:
</label>
<br />
<textarea rows="5" cols="40" name="note" id="note" maxlength="1024"></textarea>
</p>
<p>
<input type="submit" class="processing" value="Send Archived Message" />
</p>
</form>
EOF
;
return $form;
}
sub admin_js {
require DADA::Template::Widgets;
return DADA::Template::Widgets::screen(-screen => 'admin_js.tmpl');
}
sub default_css {
require DADA::Template::Widgets;
return DADA::Template::Widgets::screen(-screen => 'default_css.css');
}
=pod
=head1 Changes
B<3/29/01> - Tweaked the POD a bit.
=head1 COPYRIGHT
Copyright (c) 1999 - 2006 Justin Simoni
http://justinsimoni.com
All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
=cut
1;