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($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,
@_);
# This is horrible.
$Yeah_Root_Login = 1
if $args{-Root_Login} == 1;
require DADA::Template::Widgets::Admin_Menu;
my $ADMIN_MENU;
require DADA::MailingList::Settings;
my $ls = DADA::MailingList::Settings->new(-List => $args{-List});
my $li = $ls->get;
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 class="rootloginmsg">Logged in as Root</span>';
}
my $header_part;
if($ADMIN_TEMPLATE){
my ($saved_header, $saved_footer) = fetch_admin_template($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}, -f => $q->param('flavor'));
}
$header_part = $header_part . qq{<form action="[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\]/$VER/g;
$header_part =~ s/\[program_url\]/$S_PROGRAM_URL/g;
$header_part =~ s/\[root_login_message\]/$root_login_message/g;
$header_part =~ s/\[program_name\]/$PROGRAM_NAME/g;
$header_part = $q->header(-type => 'text/html', -charset => $HTML_CHARSET) . $header_part;
return $header_part;
}
############################################################################# # holds the default admin template. footer # #############################################################################
sub admin_html_footer {
my %args = (-Form => 1, -Root_Login => 0, -List => '', @_);
my $footer_part;
# This is horrible.
$Yeah_Root_Login = 1
if $args{-Root_Login} == 1;
require DADA::Template::Widgets::Admin_Menu;
my $ADMIN_MENU;
require DADA::MailingList::Settings;
my $ls = DADA::MailingList::Settings->new(-List => $args{-List});
my $li = $ls->get;
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($ADMIN_TEMPLATE){
my ($saved_header, $saved_footer) = fetch_admin_template($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}, -f => $q->param('flavor'));
}
$footer_part =~ s/\[program_url\]/$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 {
my $PROGRAM_URL = shift; # what was this for?
if(!$USER_TEMPLATE){
require DADA::Template::Widgets;
my $default_template = DADA::Template::Widgets::screen(-screen => 'default_list_template.tmpl');
return $default_template;
}else{
if($USER_TEMPLATE =~ m/^http/){
return open_template_from_url(-URL => $USER_TEMPLATE);
}else{
return fetch_user_template($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, $TEMPLATES) or
die "$PROGRAM_NAME $VER error, can't open $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 = $TEMPLATES .'/'. $file;
}
sysopen(TEMPLATE,"$file", O_RDONLY|O_CREAT, $FILE_CHMOD) or
die "$PROGRAM_NAME $VER Error: Can't open list template for reading at '$file': $!";
flock(TEMPLATE, LOCK_SH) or
warn "$PROGRAM_NAME $VER Error: Can't create a shared lock for template file at '$file': $!";
{
local $/ = undef;
$list_template = <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, $FILE_CHMOD) or
die "$PROGRAM_NAME $VER Error: Can't open list template for reading at '$file': $!";
flock(TEMPLATE, LOCK_SH) or
warn "$PROGRAM_NAME $VER Error: Can't create a shared lock for template file at '$file': $!";
{
#slurp it all in
local $/ = undef;
$list_template = <TEMPLATE>;
}
close (TEMPLATE);
return $list_template;
}
sub open_template {
my %args = (-List => undef,
@_);
my $list = $args{-List};
my $templatefile = make_safer($TEMPLATES . '/' . $list . '.template');
my $list_template = "";
my @template;
sysopen(TEMPLATE, $templatefile, O_RDWR|O_CREAT, $FILE_CHMOD) or
die "$PROGRAM_NAME $VER Error: Can't open list template for reading at '$templatefile': $!";
flock(TEMPLATE, LOCK_SH) or
warn "$PROGRAM_NAME $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,
@_);
$args{-List} =~ s/ /_/i if $args{-List}; #why is this even here?
if($PROGRAM_URL eq 'http://www.changetoyoursite.com/cgi-bin/dada/mail.cgi'){
$PROGRAM_URL = $q->url;
}
my $default_template = default_template($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\]/$VER/g;
$the_header =~ s/\[program_name\]/$PROGRAM_NAME/g;
$the_header =~ s/\[program_url\]/$PROGRAM_URL/g;
$the_header .= "\n<form action=\"$PROGRAM_URL\" method=\"post\">\n" if $args{-Start_Form} != 0;
if($args{-Header} == 1){
return $q->header(-type => 'text/html; ' . $HTML_CHARSET) . $the_header;
}else{
$the_header;
}
}else{
$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\]/$VER/g;
$the_footer =~ s/\[program_url\]/$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"><b><i>This form was filled out incorrectly.</i></b></p>} if $errors > 0;
my $form = <<EOF <div class=``archivesend''> <h3>Send this message to a friend:</h3>
$error_msg <form action=``$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>Your e-mail address:<br /> <input type=``text'' name=``sender_email'' /> </p> <p>Your friend's email address:<br /> <input type=``text'' name=``email'' /> </p> <p>Note:<br /> <textarea rows=``5'' cols=``40'' name=``note''></textarea> </p> <p> <input type=``submit'' class=``processing'' value=``Send Archived Message'' /> </p> </form>
</div> 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
3/29/01 - Tweaked the POD a bit.
Copyright (c) 1999 - 2005 Justin Simoni me@justinsimoni.com 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.