';
=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 {
require CGI;
my $q = CGI->new;
$q->charset($DADA::Config::HTML_CHARSET);
$q->param('flavor', $q->param('f'))
if ! defined($q->param('flavor'));
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 = 'Logged In as Root';
}
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{ ' . $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 $/; };
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 $/; };
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 = ;
close (TEMPLATE);
foreach(@template){
$list_template .= $_;
}
return $list_template;
}
sub the_html {
require CGI;
my $q = CGI->new;
$q->charset($DADA::Config::HTML_CHARSET);
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{
};
$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/\[ver\]/$DADA::Config::VER/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 ' . $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
;
return $form;
}
sub archive_send_form {
my ($list, $id, $errors, $captcha_archive_send_form, $captcha_fail) = @_;
require DADA::Template::Widgets;
my $img_string = '';
if($captcha_archive_send_form == 1){
my $captcha_worked = 0;
my $captcha_auth = 1;
require DADA::Security::AuthenCAPTCHA;
my $cap = DADA::Security::AuthenCAPTCHA->new;
$img_string = $cap->create_CAPTCHA;
}
return DADA::Template::Widgets::screen(
-screen => 'send_archive_form_widget.tmpl',
-vars => {
send_archive_form_error => $errors,
list => $list,
id => $id,
# CAPTCHA stuff
img_string => $img_string,
captcha_fail => $captcha_fail,
},
);
}
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-2007 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;