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 {
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'); }
3/29/01 - Tweaked the POD a bit.
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.