DADA::Template::HTML
Module for generating HTML templates for lists and administration
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 = '<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/\[version\]/$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;
my $go_pro;
if($DADA::Config::GIVE_PROPS_IN_ADMIN == 1){
$go_pro = '<a href="http://dadamailproject.com/purchase/pro.html">[Go Pro]</a>';
}
$header_part =~ s{\[go_pro\]}{$go_pro}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 {
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 = (-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;
my $go_pro;
if($DADA::Config::GIVE_PROPS_IN_ADMIN == 1){
$go_pro = '<a href="http://dadamailproject.com/purchase/pro.html">[Go Pro]</a>';
}
$footer_part =~ s{\[go_pro\]}{$go_pro}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 {
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{
<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/\[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<form action=\"$DADA::Config::PROGRAM_URL\" method=\"post\">\n" if $args{-Start_Form} != 0;
if($args{-Header} == 1){
return $q->header(-type => 'text/html', %{$args{-header_params}}) . $the_header;
}else{
$the_header;
}
}else{
if($DADA::Config::GIVE_PROPS_IN_HTML == 1){
$the_footer = "\n$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, $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'); }
3/29/01 - Tweaked the POD a bit.
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.
Dada Mail is Free Software and is released under the Gnu
Public License.
Dada Mail is written in Perl because we love Perl.