0.13_01 commit r0_13_01
authorTony Cook <tony@develop-help.com>
Tue, 13 May 2003 00:48:42 +0000 (00:48 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Tue, 13 May 2003 00:48:42 +0000 (00:48 +0000)
22 files changed:
MANIFEST
Makefile
schema/bse.sql
site/cgi-bin/admin/subs.pl
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Formatter.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Permissions.pm
site/cgi-bin/modules/BSE/SubscriptionType.pm
site/cgi-bin/modules/BSE/Util/Tags.pm
site/cgi-bin/modules/DevHelp/Formatter.pm [new file with mode: 0644]
site/cgi-bin/modules/DevHelp/Tags.pm
site/cgi-bin/modules/Generate.pm
site/cgi-bin/modules/Generate/Article.pm
site/cgi-bin/modules/Image.pm
site/docs/bse.pod
site/htdocs/admin/help/image.html
site/templates/admin/article_img.tmpl
site/templates/admin/subs/list.tmpl
site/templates/admin/subs/sending.tmpl [new file with mode: 0644]
t/t050format.t [new file with mode: 0644]
t/t20gen.t

index 079267d..66b535c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -54,6 +54,7 @@ site/cgi-bin/modules/BSE/EmailBlackEntry.pm
 site/cgi-bin/modules/BSE/EmailBlacklist.pm
 site/cgi-bin/modules/BSE/EmailRequest.pm
 site/cgi-bin/modules/BSE/EmailRequests.pm
+site/cgi-bin/modules/BSE/Formatter.pm
 # site/cgi-bin/modules/BSE/FileEditor.pm
 site/cgi-bin/modules/BSE/Mail.pm
 site/cgi-bin/modules/BSE/Mail/SMTP.pm
@@ -86,6 +87,7 @@ site/cgi-bin/modules/BSE/Util/Tags.pm
 site/cgi-bin/modules/BSE/Util/Valid.pm
 site/cgi-bin/modules/BSE/Version.pm
 site/cgi-bin/modules/Constants.pm
+site/cgi-bin/modules/DevHelp/Formatter.pm
 site/cgi-bin/modules/DevHelp/HTML.pm
 site/cgi-bin/modules/DevHelp/Report.pm
 site/cgi-bin/modules/DevHelp/Tags.pm
@@ -240,6 +242,7 @@ site/templates/admin/showuser_glob.tmpl
 site/templates/admin/subs/delete.tmpl
 site/templates/admin/subs/edit.tmpl
 site/templates/admin/subs/list.tmpl
+site/templates/admin/subs/sending.tmpl
 site/templates/admin/subs/send_form.tmpl
 site/templates/admin/subs/start_send.tmpl
 site/templates/admin/userlist.tmpl
@@ -313,6 +316,7 @@ site/util/mysql.str
 site/util/upgrade_mysql.pl
 t/BSE/Test.pm
 t/t00smoke.t
+t/t050format.t
 t/t10edit.t
 t/t20gen.t
 t/t30rules.t   Check for use strict and warnings
index 9fc8e3d..04d81da 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.13
+VERSION=0.13_01
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
@@ -96,7 +96,7 @@ testfiles: distdir
        perl -MExtUtils::Command -e rm_rf $(DISTBUILD)
 
 test: testinst
-       perl -MTest::Harness=runtests -It -e 'runtests glob q!t/*.t!'
+       perl -MTest::Harness=runtests -Isite/cgi-bin/modules -It -e 'runtests glob q!t/*.t!'
 
 manicheck:
        perl -MExtUtils::Manifest=manicheck -e 'manicheck()'
index 78a754e..c59614b 100644 (file)
@@ -109,6 +109,7 @@ CREATE TABLE image (
   height smallint(5) unsigned,
   url varchar(255),
   displayOrder integer not null default 0,
+  name varchar(255) default '' not null,
 
   PRIMARY KEY (id)
 );
index 8b7de90..3e84393 100755 (executable)
@@ -51,6 +51,15 @@ else {
   refresh_to($req->url('logon'));
 }
 
+sub tag_recipient_count {
+  my ($subs, $subindex) = @_;
+
+  $$subindex >= 0 && $$subindex < @$subs
+    or return '** subscriber_count only valid inside subscriptions iterator **';
+
+  $subs->[$$subindex]->recipient_count;
+}
+
 sub list {
   my ($q, $req, $cfg, $message) = @_;
 
@@ -65,6 +74,7 @@ sub list {
                                    \$subindex),
      BSE::Util::Tags->secure($req),
      message => sub { CGI::escapeHTML($message) },
+     recipient_count => [ \&tag_recipient_count, \@subs, \$subindex ],
     );
   BSE::Template->show_page('admin/subs/list', $cfg, \%acts);
 }
@@ -466,7 +476,7 @@ sub send_message {
 
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
   my $id = $q->param('id')
-    or return _refresh_list($q, $cfg, $msgs->(startnoid=>"No id supplied to be edited"));
+    or return _refresh_list($q, $cfg, $msgs->(startnoid=>"No id supplied to be sent"));
   my $sub = BSE::SubscriptionTypes->getByPkey($id)
     or return _refresh_list($q, $cfg, $msgs->(startnosub=>"Cannot find record $id"));
 
@@ -483,15 +493,34 @@ sub send_message {
       or delete $opts{parentId};
   }
 
-  print "Content-Type: text/html\n\n";
-  print "<html><head><title>Send Subscription - BSE</title></head>";
-  print "<body><h2>Send Subscription</h2>\n";
+  my $template = BSE::Template->get_source('admin/subs/sending', $cfg);
+
+  my ($prefix, $permessage, $suffix) = 
+    split /<:\s*iterator\s+(?:begin|end)\s+messages\s*:>/, $template;
+  my $acts_message;
+  my $acts_user;
+  my $is_error;
+  my %acts;
+  %acts =
+    (
+     BSE::Util::Tags->basic(\%acts, $q, $cfg),
+     BSE::Util::Tags->admin(\%acts, $cfg),
+     subscription => sub { escape_html($sub->{$_[0]}) },
+     message => sub { $acts_message },
+     user => sub { $acts_user ? escape_html($acts_user->{$_[0]}) : '' },
+     ifUser => sub { $acts_user },
+     ifError => sub { $is_error },
+    );
+  BSE::Template->show_replaced($prefix, $cfg, \%acts);
   $sub->send($cfg, \%opts,
             sub {
-              print "<div>",CGI::escapeHTML($_[0]),"</div>\n";
+              my ($type, $user, $msg) = @_;
+              $acts_message = defined($msg) ? $msg : '';
+              $acts_user = $user;
+              $is_error = $type eq 'error';
+              print BSE::Template->replace($permessage, $cfg, \%acts);
             });
-  print qq!<p><a target="_top" href="/cgi-bin/admin/menu.pl">Back to Admin Menu</a></p>\n!;
-  print "</body></html>\n";
+  print BSE::Template->replace($suffix, $cfg, \%acts);
 }
 
 sub req_delconfirm {
index 3eebedf..2a3dff5 100644 (file)
@@ -44,8 +44,8 @@ EOS
 
    Images => 'select * from image',
    replaceImage =>
-     'replace image values (?,?,?,?,?,?,?,?)',
-   addImage => 'insert image values(null, ?, ?, ?, ?, ?, ?, ?)',
+     'replace image values (?,?,?,?,?,?,?,?,?)',
+   addImage => 'insert image values(null, ?, ?, ?, ?, ?, ?, ?, ?)',
    deleteImage => 'delete from image where id = ?',
    getImageByArticleId => 'select * from image where articleId = ? order by displayOrder',
    
@@ -134,6 +134,10 @@ EOS
    'select * from subscription_types where id = ? order by name',
    deleteSubscriptionType =>
    'delete from subscription_types where id = ?',
+   subRecipientCount => <<EOS,
+select count(*) as "count" from site_users si, subscribed_users su
+  where confirmed <> 0 and si.id = su.userId and su.subId = ?
+EOS
 
    addSubscribedUser=>
    'insert subscribed_users values(null,?,?)',
index 234ee3d..fa8afa3 100644 (file)
@@ -1906,6 +1906,9 @@ sub save_image_changes {
     $article->save;
   }
   my @images = $article->images;
+  
+  @images or
+    return $self->refresh($article, $cgi, undef, 'No images to save information for');
 
   my $changed;
   my @alt = $cgi->param('alt');
@@ -1924,6 +1927,33 @@ sub save_image_changes {
       $images[$index]{url} = $urls[$index];
     }
   }
+  my %errors;
+  my @names = map scalar($cgi->param('name'.$_)), 0..$#images;
+  if (@names) {
+    # make sure there aren't any dups
+    my %used;
+    my $index = 0;
+    for my $name (@names) {
+      defined $name or $name = '';
+      if ($name ne '') {
+       if ($name =~ /^[a-z_]\w*$/i) {
+         if ($used{lc $name}++) {
+           $errors{"name$index"} = 'Names must be empty, or alphanumeric and unique to the article';
+         }
+       }
+       else {
+         $errors{"name$index"} = 'Image identifiers must be unique to the article';
+       }
+      }
+      ++$index;
+    }
+  }
+  keys %errors
+    and return $self->edit_form($req, $article, $articles, undef,
+                               \%errors);
+  for my $index (0..$#images) {
+    $images[$index]{name} = $names[$index];
+  }
   if ($changed) {
     for my $image (@images) {
       $image->save;
@@ -1933,7 +1963,6 @@ sub save_image_changes {
   use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
-
   return $self->refresh($article, $cgi, undef, 'Image information saved');
 }
 
@@ -1946,17 +1975,42 @@ sub add_image {
 
   my $cgi = $req->cgi;
 
+  my %errors;
+  my $msg;
+  my $imageref = $cgi->param('name');
+  if (defined $imageref) {
+    if ($imageref =~ /^[a-z_]\w+$/i) {
+      # make sure it's unique
+      my @images = $article->images;
+      for my $img (@images) {
+       if (defined $img->{name} && lc $img->{name} eq lc $imageref) {
+         $errors{name} = 'Duplicate image name';
+         last;
+       }
+      }
+    }
+    else {
+      $errors{name} = 'Name must be empty or alphanumeric';
+    }
+  }
+  else {
+    $imageref = '';
+  }
+
   my $image = $cgi->param('image');
-  unless ($image) {
-    return $self->edit_form($req, $article, $articles,
-                             'Enter or select the name of an image file on your machine', 
-                             { image => 'Please enter an image filename' });
+  if ($image) {
+    if (-z $image) {
+      $errors{image} = 'Image file is empty';
+    }
   }
-  if (-z $image) {
-    return $self->edit_form($req, $article, $articles,
-                             'Image file is empty',
-                            { image => 'Image file is empty' });
+  else {
+    $msg = 'Enter or select the name of an image file on your machine';
+    $errors{image} = 'Please enter an image filename';
+  }
+  if ($msg || keys %errors) {
+    return $self->edit_form($req, $article, $articles, $msg, \%errors);
   }
+
   my $imagename = $image;
   $imagename .= ''; # force it into a string
   my $basename = '';
@@ -2009,6 +2063,7 @@ sub add_image {
      height => $height,
      url => $url,
      displayOrder=>time,
+     name => $imageref,
     );
   require Images;
   my @cols = Image->columns;
diff --git a/site/cgi-bin/modules/BSE/Formatter.pm b/site/cgi-bin/modules/BSE/Formatter.pm
new file mode 100644 (file)
index 0000000..02e942d
--- /dev/null
@@ -0,0 +1,67 @@
+package BSE::Formatter;
+use strict;
+
+use base 'DevHelp::Formatter';
+
+sub new {
+  my ($class, $gen, $acts, $articles, $rauto_images, $images) = @_;
+
+  my $self = $class->SUPER::new;
+
+  $self->{gen} = $gen;
+  $self->{acts} = $acts;
+  $self->{articles} = $articles;
+  $self->{auto_images} = $rauto_images;
+  $self->{images} = $images;
+  #$self->{level} = $level;
+
+  $self;
+}
+
+sub image {
+  my ($self, $args) = @_;
+
+  my $images = $self->{images};
+  my ($index, $align, $url) = split /\|/, $args, 3;
+  my $text = '';
+  my $im;
+  if ($index =~ /^\d+$/) {
+    if ($index >=1 && $index <= @$images) {
+      $im = $images->[$index-1];
+    }
+  }
+  elsif ($index =~ /^[a-z]\w*$/i){
+    # scan the names
+    for my $image (@$images) {
+      if ($image->{name} && lc $image->{name} eq lc $index) {
+       $im = $image;
+       last;
+      }
+    }
+  }
+  if ($im) {
+    $text = qq!<img src="/images/$im->{image}" width="$im->{width}"!
+      . qq! height="$im->{height}" alt="! . escape_html($im->{alt}).'"'
+       . qq! border="0"!;
+    $text .= qq! align="$align"! if $align && $align ne 'center';
+    $text .= qq! />!;
+    $text = qq!<div align="center">$text</div>!
+      if $align && $align eq 'center';
+    if (!$url && $im->{url}) {
+      $url = $im->{url};
+    }
+    if ($url) {
+      $text = qq!<a href="! . escape_html($url) . qq!">$text</a>!;
+    }
+  }
+  return $text;
+}
+
+sub embed {
+  my ($self, $name, $templateid, $maxdepth) = @_;
+
+  $self->{gen}->_embed_low($self->{acts}, $self->{articles}, $name,
+                          $templateid, $maxdepth);
+}
+
+1;
index 0f4a4af..1d1a4a2 100644 (file)
@@ -195,6 +195,7 @@ sub _get_article {
        id=>-1,
        parentid=>0,
        title=>'The site',
+       level => 0,
       };
     return $self->{sitearticle};
   }
index c85b3a1..d239161 100644 (file)
@@ -123,12 +123,25 @@ sub html_format {
   return $gen->generate(\%article, 'Articles');
 }
 
+sub recipients {
+  my ($sub) = @_;
+
+  require 'SiteUsers.pm';
+  SiteUsers->getSpecial('subRecipients', $sub->{id});
+}
+
+sub recipient_count {
+  my ($sub) = @_;
+
+  my @rows = BSE::DB->query(subRecipientCount => $sub->{id});
+  $rows[0]{count};
+}
+
 sub send {
   my ($sub, $cfg, $opts, $callback) = @_;
 
-  require 'SiteUsers.pm';
-  my @recipients = SiteUsers->getSpecial('subRecipients', $sub->{id});
-  $callback->(scalar(@recipients)." recipients to process");
+  my @recipients = $sub->recipients;
+  $callback->('general', undef, scalar(@recipients)." recipients to process");
   require 'BSE/Mail.pm';
   my $mailer = BSE::Mail->new(cfg=>$cfg);
   my %article;
@@ -147,7 +160,7 @@ sub send {
   my $charset = $cfg->entry('basic', 'charset') || 'iso-8859-1';
   my $index = 0;
   for my $user (@recipients) {
-    $callback->($user->{email}) if $callback;
+    $callback->('user', $user) if $callback;
     my $text = $sub->_text_format_low($cfg, $user, $opts, \%article);
     my $html;
     if ($gen && !$user->{textOnlyMail}) {
@@ -181,13 +194,13 @@ sub send {
                          subject =>$article{title}, 
                          headers =>join("\n", @headers, ""),
                          body    =>$content)) {
-      $callback->("Error: ".$mailer->errstr);
+      $callback->('error', $user, scalar($mailer->errstr));
     }
     ++$index;
   }
   if (exists $opts->{archive} && $opts->{archive}
       || $sub->{archive}) {
-    $callback->("Archiving article");
+    $callback->('general', undef, "Archiving article");
     require 'Articles.pm';
     $article{template} = $opts->{article_template} || $sub->{article_template};
     $article{generator} = 'Generate::Article';
@@ -206,7 +219,7 @@ sub send {
     $article->save;
     require 'Util.pm';
     
-    $callback->("Generating article");
+    $callback->('general', undef, "Generating article");
     Util::generate_article('Articles', $article, $cfg);
   }
   use BSE::Util::SQL qw/now_datetime/;
index 308ab43..faef93c 100644 (file)
@@ -508,11 +508,13 @@ sub secure {
 }
 
 sub tag_error_img {
-  my ($cfg, $errors, $args) = @_;
+  my ($cfg, $errors, $args, $acts, $func, $templater) = @_;
 
-  return '' unless $errors->{$args};
+  my ($arg) = DevHelp::Tags->get_parms($args, $acts, $templater);
+  #print STDERR "name $arg\n";
+  return '' unless $errors->{$arg};
   my $images_uri = $cfg->entry('uri', 'images', '/images');
-  my $encoded = escape_html($errors->{$args});
+  my $encoded = escape_html($errors->{$arg});
   return qq!<img src="$images_uri/admin/error.gif" alt="$encoded" title="$encoded" border="0" align="top" />!; 
 }
 
diff --git a/site/cgi-bin/modules/DevHelp/Formatter.pm b/site/cgi-bin/modules/DevHelp/Formatter.pm
new file mode 100644 (file)
index 0000000..0908a3d
--- /dev/null
@@ -0,0 +1,326 @@
+package DevHelp::Formatter;
+use strict;
+use DevHelp::HTML;
+
+sub new {
+  my ($class) = @_;
+
+  return bless {}, $class;
+}
+
+sub embed {
+  '';
+}
+
+sub image {
+  my ($self, $imagename, $align) = @_;
+
+  return '';
+}
+
+sub replace {
+}
+
+sub _make_hr {
+  my ($width, $height) = @_;
+  my $tag = "<hr";
+  $tag .= qq! width="$width"! if length $width;
+  $tag .= qq! height="$height"! if length $height;
+  $tag .= " />";
+  return $tag;
+}
+
+# produces a table, possibly with options for the <table> and <tr> tags
+sub _make_table {
+  my ($options, $text) = @_;
+  my $tag = "<table";
+  my $cellend = '';
+  my $cellstart = '';
+  if ($options =~ /=/) {
+    $tag .= " " . $options;
+  }
+  elsif ($options =~ /\S/) {
+    $options =~ s/\s+$//;
+    my ($width, $bg, $pad, $fontsz, $fontface) = split /\|/, $options;
+    for ($width, $bg, $pad, $fontsz, $fontface) {
+      $_ = '' unless defined;
+    }
+    $tag .= qq! width="$width"! if length $width;
+    $tag .= qq! bgcolor="$bg"! if length $bg;
+    $tag .= qq! cellpadding="$pad"! if length $pad;
+    if (length $fontsz || length $fontface) {
+      $cellstart = qq!<font!;
+      $cellstart .= qq! size="$fontsz"! if length $fontsz;
+      $cellstart .= qq! face="$fontface"! if length $fontface;
+      $cellstart .= qq!>!;
+      $cellend = "</font>";
+    }
+  }
+  $tag .= ">";
+  my @rows = split '\n', $text;
+  my $maxwidth = 0;
+  for my $row (@rows) {
+    my ($opts, @cols) = split /\|/, $row;
+    $tag .= "<tr";
+    if ($opts =~ /=/) {
+      $tag .= " ".unescape_html($opts);
+    }
+    $tag .= "><td>$cellstart".join("$cellend</td><td>$cellstart", @cols)
+      ."$cellend</td></tr>";
+  }
+  $tag .= "</table>";
+  return $tag;
+}
+
+# make a UL
+sub _format_bullets {
+  my ($text) = @_;
+
+  $text =~ s/^\s+|\s+$//g;
+  my @points = split /(?:\r?\n)?\*\*\s*/, $text;
+  shift @points if @points and $points[0] eq '';
+  return '' unless @points;
+  for my $point (@points) {
+    $point =~ s!\n$!<br /><br />!;
+  }
+  return "<ul><li>".join("</li><li>", @points)."</li></ul>";
+}
+
+# make a OL
+sub _format_ol {
+  my ($text) = @_;
+  $text =~ s/^\s+|\s+$//g;
+  my @points = split /(?:\r?\n)?##\s*/, $text;
+  shift @points if @points and $points[0] eq '';
+  return '' unless @points;
+  for my $point (@points) {
+    $point =~ s!\n$!<br /><br />!;
+  }
+  return "<ol><li>".join("</li><li>", @points)."</li></ol>";
+}
+
+# raw html - this has some limitations
+# the input text has already been escaped, so we need to unescape it
+# too bad if you want [] in your html (but you can use entities)
+sub _make_html {
+  return unescape_html($_[0]);
+}
+
+sub _fix_spanned {
+  my ($start, $end, $text) = @_;
+
+  $text =~ s!(\n(?:[ \r]*\n)+)!$end$1$start!g;
+
+  "$start$text$end";
+}
+
+sub replace_char {
+  my ($self, $rpart) = @_;
+
+  $$rpart =~ s#link\[([^|\]\[]+)\|([^\]\[]+)\]#<a href="$1">$2</a>#ig
+    and return 1;
+  $$rpart =~ s#b\[([^\]\[]+)\]#_fix_spanned("<b>", "</b>", $1)#egi
+    and return 1;
+  $$rpart =~ s#i\[([^\]\[]+)\]#_fix_spanned("<i>", "</i>", $1)#egi
+    and return 1;
+  $$rpart =~ s#tt\[([^\]\[]+)\]#_fix_spanned("<tt>", "</tt>", $1)#egi
+    and return 1;
+  $$rpart =~ s#font\[([^|\]\[]+)\|([^\]\[]+)\]#
+    _fix_spanned(qq/<font size="$1">/, "</font>", $2)#egi
+      and return 1;
+  $$rpart =~ s#anchor\[([^|\]\[]*)\]#<a name="$1"></a>#ig
+    and return 1;
+  $$rpart =~ s#fontcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#
+    _fix_spanned(qq/<font size="$1" color="$2">/, "</font>", $3)#egi
+      and return 1;
+  
+  return 0;
+}
+
+sub format {
+  my ($self, $body) = @_;
+
+  $body = escape_html($body);
+  my $out = '';
+  for my $part (split /((?:html\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])
+                       |embed\[(?:[^,\[\]]*)(?:,(?:[^,\[\]]*)){0,2}\]
+                        |pre\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])/ix, $body) {
+    #print STDERR "Part is $part\n";
+    if ($part =~ /^html\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
+      $out .= _make_html($1);
+    }
+    elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*),([^,\[\]]*)\]$/i) {
+      $out .= $self->embed($1, $2, $3);
+    }
+    elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*)\]$/i) {
+      $out .= $self->embed($1, $2);
+    }
+    elsif ($part =~ /^embed\[([^,\[\]]*)\]$/i) {
+      $out .= $self->embed($1)
+    }
+    elsif ($part =~ /^pre\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
+      my $work = $1;
+      1 while $self->replace_char(\$work);
+      $out .= $work;
+    }
+    else {
+    TRY: while (1) {
+       $self->replace(\$part)
+         and next TRY;
+       $self->replace_char(\$part)
+         and next TRY;
+       $part =~ s#pre\[([^\]\[]+)\]#<pre>$1</pre>#ig
+         and next TRY;
+       $part =~ s#h([1-6])\[\|([^\[\]]+)\](?:\r?\n)?#<h$1>$2</h$1>#ig
+          and next TRY;
+       $part =~ s#h([1-6])\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#<h$1 class="$2">$3</h$1>#ig
+          and next TRY;
+       $part =~ s#align\[([^|\]\[]+)\|([^\]\[]+)\]#<div align="$1">$2</div>#ig
+         and next TRY;
+       $part =~ s#hr\[([^|\]\[]*)\|([^\]\[]*)\]#_make_hr($1, $2)#ieg
+         and next TRY;
+       $part =~ s#hr\[([^|\]\[]*)\]#_make_hr($1, '')#ieg
+         and next TRY;
+       $part =~ s#table\[([^\n\[\]]*)\n([^\[\]]+)\n\s*\]#_make_table($1, $2)#ieg
+         and next TRY;
+       $part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_make_table($1, "|$2")#ieg
+         and next TRY;
+       $part =~ s#\n{0,2}((?:\*\*[^\n]+(?:\n|$)\n?[^\S\n]*)+)\n?#_format_bullets($1)#eg
+         and next TRY;
+       $part =~ s!\n{0,2}((?:##[^\n]+(?:\n|$)\n?[^\S\n]*)+)\n?!_format_ol($1)!eg
+         and next TRY;
+       $part =~ s#indent\[([^\]\[]+)\]#<ul>$1</ul>#ig
+         and next TRY;
+       $part =~ s#center\[([^\]\[]+)\]#<center>$1</center>#ig
+         and next TRY;
+       $part =~ s#hrcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#<table width="$1" height="$2" border="0" bgcolor="$3" cellpadding="0" cellspacing="0"><tr><td><img src="/images/trans_pixel.gif" width="1" height="1" /></td></tr></table>#ig
+         and next TRY;
+       $part =~ s#image\[([^\]\[]+)\]# $self->image($1) #ige
+           and next TRY;
+       last;
+      }
+      $part =~ s!(\n([ \r]*\n)*)!$1 eq "\n" ? "<br />\n" : "</p>\n<p>"!eg;
+      #$part =~ s!\n!<br />!g;
+      $out .= $part;
+    }
+  }
+  
+  return $out;
+}
+
+sub remove_format {
+  my ($self, $body) = @_;
+
+  if ($body =~ /^<html>/i) {
+    return _strip_html(substr($body, 6));
+  }
+
+  my $out = '';
+  for my $part (split /((?:html\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])
+                       |embed\[(?:[^,\[\]]*)(?:,(?:[^,\[\]]*)){0,2}\])/ix, $body) {
+    #print STDERR "Part is $part\n";
+    if ($part =~ /^html\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
+      $out .= _strip_html($1);
+    }
+    elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*)\]$/i) {
+      $out .= ""; # what would you do here?
+    }
+    elsif ($part =~ /^embed\[([^,\[\]]*)\]$/i) {
+      $out .= "";
+    }
+    else {
+    TRY: while (1) {
+       $self->remove(\$part)
+         and next TRY;
+       $part =~ s#link\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
+         and next TRY;
+       $part =~ s#([bi])\[([^\]\[]+)\]#$2#ig
+         and next TRY;
+       $part =~ s#align\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
+         and next TRY;
+       $part =~ s#font\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
+         and next TRY;
+       $part =~ s#hr\[([^|\]\[]*)\|([^\]\[]*)\]##ig
+         and next TRY;
+       $part =~ s#hr\[([^|\]\[]*)\]##ig
+         and next TRY;
+       $part =~ s#anchor\[([^|\]\[]*)\]##ig
+         and next TRY;
+       $part =~ s#table\[([^\n\[\]]*)\n([^\[\]]+)\n\s*\]#_cleanup_table($1, $2)#ieg
+         and next TRY;
+       $part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_cleanup_table($1, "|$2")#ieg
+         and next TRY;
+       $part =~ s#\*\*([^\n]+)#$1#g
+         and next TRY;
+       $part =~ s!##([^\n]+)!$1!g
+         and next TRY;
+       $part =~ s#fontcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#$3#ig
+         and next TRY;
+       $part =~ s#(?:indent|center)\[([^\]\[]*)\]#$1#ig
+         and next TRY;
+       $part =~ s#hrcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]##ig
+         and next TRY;
+       $part =~ s#image\[([^\]\[]+)\]##ig
+         and next TRY;
+       
+       last TRY;
+      }
+      $out .= $part;
+    }
+  } 
+
+  return $out;
+}
+
+sub remove {
+  0;
+}
+
+# removes any html tags from the supplied text
+sub _strip_html {
+  my ($text) = @_;
+
+  my $out = '';
+  require HTML::Parser;
+  
+  # this may need to detect and skip <script></script> and stylesheets
+  my $ignore_text = 0; # non-zero in a <script></script> or <style></style>
+  my $start_h = 
+    sub {
+      ++$ignore_text if $_[0] eq 'script' or $_[0] eq 'style';
+       if ($_[0] eq 'img' && $_[1]{alt} && !$ignore_text) {
+         $out .= $_[1]{alt};
+       }
+    };
+  my $end_h = 
+    sub {
+      --$ignore_text if $_[0] eq 'script' or $_[0] eq 'style';
+    };
+    my $text_h = 
+      sub { 
+       $out .= $_[0] unless $ignore_text
+      };
+  my $p = HTML::Parser->new( text_h  => [ $text_h,  "dtext" ],
+                            start_h => [ $start_h, "tagname, attr" ],
+                            end_h   => [ $end_h,   "tagname" ]);
+  $p->parse($text);
+  $p->eof();
+  
+  $text = $out;
+
+  return $text;
+}
+
+# this takes the same inputs as _make_table(), but eliminates any
+# markup instead
+sub _cleanup_table {
+  my ($opts, $data) = @_;
+  my @lines = split /\n/, $data;
+  for (@lines) {
+    s/^[^|]*\|//;
+    tr/|/ /s;
+  }
+  return join(' ', @lines);
+}
+
+1;
index a822ced..0ee5b65 100644 (file)
@@ -328,7 +328,17 @@ sub get_parms {
   print STDERR "** Entered get_parms -$args-\n" if DEBUG_GET_PARMS;
   my @out;
   while ($args) {
-    if ($args =~ s/^\s*\[\s*(\w+)(?:\s+(\S[^\]]*))?\]\s*//) {
+    if ($args =~ s/^\s*\[\s*(\w+)
+                       (
+                        (?:\s+
+                         (?:
+                          [^\s\[\]]\S*
+                          |
+                          \[[^\]\[]+?\]
+                         )
+                        )*
+                        )
+                   \s*\]\s*//x) {
       my ($func, $subargs) = ($1, $2);
       $subargs = '' unless defined $subargs;
       if ($acts->{$func}) {
index fd96777..23669ab 100644 (file)
@@ -274,98 +274,12 @@ sub format_body {
 
   return substr($body, 6) if $body =~ /^<html>/i;
 
-  # clean up any possible existing markup
-  $body = escape_html($body);
-  
-  # I considered replacing these with single character codes and replacing
-  # them later with the tags, to avoid having to check for the middle of 
-  # tag in the image tag insertion code
-  #
-  # This wouldn't work because we still need to do the entity substitution
-  # before
-
+  require BSE::Formatter;
 
-  # originally the following was just one big loop of replacements, but
-  # some tags are a little more complex
-  # This needs a real parser
+  my $formatter = BSE::Formatter->new($self, $acts, $articles, \$auto_images,
+                                     \@images);
 
-  my $out = '';
-  for my $part (split /((?:html\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])
-                       |embed\[(?:[^,\[\]]*)(?:,(?:[^,\[\]]*)){0,2}\])/ix, $body) {
-    #print STDERR "Part is $part\n";
-    if ($part =~ /^html\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
-      $out .= _make_html($1);
-    }
-    elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*),([^,\[\]]*)\]$/i) {
-      $out .= $self->_body_embed($acts, $articles, $1, $2, $3);
-    }
-    elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*)\]$/i) {
-      $out .= $self->_body_embed($acts, $articles, $1, $2);
-    }
-    elsif ($part =~ /^embed\[([^,\[\]]*)\]$/i) {
-      $out .= $self->_body_embed($acts, $articles, $1, "")
-    }
-    else {
-      my $match;
-    TRY: while (1) {
-       $match = 0;
-       $LOCAL_FORMAT and $LOCAL_FORMAT->body(\$part)
-         and next TRY;
-       $part =~ s#a\[([^,\]\[]+),([^\]\[]+)\]#<a href="$1">$2</a>#ig
-         and next TRY;
-       $part =~ s#link\[([^|\]\[]+)\|([^\]\[]+)\]#<a href="$1">$2</a>#ig
-         and next TRY;
-       $part =~ s#b\[([^\]\[]+)\]#<b>$1</b>#ig
-         and next TRY;
-       $part =~ s#i\[([^\]\[]+)\]#<i>$1</i>#ig
-         and next TRY;
-       $part =~ s#tt\[([^\]\[]+)\]#<tt>$1</tt>#ig
-         and next TRY;
-       $part =~ s#pre\[([^\]\[]+)\]#<pre>$1</pre>#ig
-         and next TRY;
-       $part =~ s#h([1-6])\[\|([^\[\]]+)\](?:\r?\n)?#<h$1>$2</h$1>#ig
-          and next TRY;
-       $part =~ s#h([1-6])\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#<h$1 class="$2">$3</h$1>#ig
-          and next TRY;
-       $part =~ s#align\[([^|\]\[]+)\|([^\]\[]+)\]#<div align="$1">$2</div>#ig
-         and next TRY;
-       $part =~ s#font\[([^|\]\[]+)\|([^\]\[]+)\]#<font size="$1">$2</font>#ig
-         and next TRY;
-       $part =~ s#hr\[([^|\]\[]*)\|([^\]\[]*)\]#_make_hr($1, $2)#ieg
-         and next TRY;
-       $part =~ s#hr\[([^|\]\[]*)\]#_make_hr($1, '')#ieg
-         and next TRY;
-       $part =~ s#anchor\[([^|\]\[]*)\]#<a name="$1"></a>#ig
-         and next TRY;
-       $part =~ s#table\[([^\n\[\]]*)\n([^\[\]]+)\n\s*\]#_make_table($1, $2)#ieg
-         and next TRY;
-       $part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_make_table($1, "|$2")#ieg
-         and next TRY;
-       $part =~ s#\n{0,2}((?:\*\*[^\n]+(?:\n|$)\n?[^\S\n]*)+)\n?#_format_bullets($1)#eg
-         and next TRY;
-       $part =~ s!\n{0,2}((?:##[^\n]+(?:\n|$)\n?[^\S\n]*)+)\n?!_format_ol($1)!eg
-         and next TRY;
-       $part =~ s#fontcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#<font size="$1" color="$2">$3</font>#ig
-         and next TRY;
-       $part =~ s#indent\[([^\]\[]+)\]#<ul>$1</ul>#ig
-         and next TRY;
-       $part =~ s#center\[([^\]\[]+)\]#<center>$1</center>#ig
-         and next TRY;
-       $part =~ s#hrcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#<table width="$1" height="$2" border="0" bgcolor="$3" cellpadding="0" cellspacing="0"><tr><td><img src="/images/trans_pixel.gif" width="1" height="1" /></td></tr></table>#ig
-         and next TRY;
-       $part =~ s#image\[([^\]\[]+)\]#($auto_images = 0), _make_img($1, \$imagePos, \@images)#ige
-         and next TRY;
-       $part =~ s#class\[([^\]\[\|]+)\|([^\]\[]+)\]#<span class="$1">$2</span>#ig
-         and next TRY;
-       
-       last;
-      }
-      $part =~ s!\n([ \r]*\n)+!</p><p>!g;
-      $part =~ s/\n/<br \/>/g;
-      $out .= $part;
-    }
-  }
-  $body = $out;
+  $body = $formatter->format($body);
 
   if ($auto_images && @images) {
     # the first image simply goes where we're told to put it
@@ -415,7 +329,7 @@ sub format_body {
 
        substr($body, $workpos, 0) = <<IMG;
 <img src="/images/$image->{image}" width="$image->{width}" height="$image->{height}"
-border="0" alt="$image->{alt}" align="$align" hspace="10" vspace="10">
+border="0" alt="$image->{alt}" align="$align" hspace="10" vspace="10" />
 IMG
        $pos -= $incr;
        $align = $align eq 'right' ? 'left' : 'right';
index d069bbc..d899112 100644 (file)
@@ -58,6 +58,63 @@ sub generate_low {
   return BSE::Template->replace($template, $self->{cfg}, \%acts);
 }
 
+sub _format_image {
+  my ($im, $align, $rest) = @_;
+
+  if ($align && exists $im->{$align}) {
+    return escape_html($im->{$align});
+  }
+  else {
+    my $html = qq!<img src="/images/$im->{image}" width="$im->{width}"!
+      . qq! height="$im->{height}" alt="! . escape_html($im->{alt})
+            . qq!"!;
+    $html .= qq! align="$align"! if $align && $align ne '-';
+    unless (defined($rest) && $rest =~ /\bborder=/i) {
+      $html .= ' border="0"';
+    }
+    $html .= " $rest" if defined $rest;
+    $html .= qq! />!;
+    if ($im->{url}) {
+      $html = qq!<a href="$im->{url}">$html</a>!;
+    }
+    return $html;
+  }
+}
+
+sub tag_title {
+  my ($article, $images, $args, $acts, $funcname, $templater) = @_;
+
+  my $which = $args || 'article';
+
+  exists $acts->{$which} 
+    or return "** no such object $which **";
+
+  my $title = $acts->{$which}->('title');
+  my $imagename = $which eq 'article' ? $article->{titleImage} : 
+    $acts->{$which}->('titleImage');
+  $imagename and
+    return qq!<img src="/images/titles/$imagename"!
+      .qq! border="0" alt="$title" />! ;
+  my $im;
+  if ($which eq 'article') {
+    ($im) = grep lc $_->{name} eq 'bse_title', @$images;
+  }
+  else {
+    my $id = $acts->{$which}->('id');
+    require Images;
+    my @images = Images->getBy(articleId=>$id);
+    ($im) = grep lc $_->{name} eq 'bse_title', @$images;
+  }
+
+  if ($im) {
+    return qq!<img src="/images/$im->{image}" width="$im->{width}"!
+      . qq! height="$im->{height}" alt="$title" />!;
+  }
+  else {
+    return $title;
+  }
+}
+
 sub baseActs {
   my ($self, $articles, $acts, $article, $embedded) = @_;
 
@@ -67,7 +124,7 @@ sub baseActs {
 
   # used to generate a navigation list for the article
   # generate a list of ancester articles/sections
-  # jason calls these breadcrumbs
+  # Jason calls these breadcrumbs
   my @crumbs;
   my @ancestors;
   my $temp = $article;
@@ -110,14 +167,7 @@ sub baseActs {
        my $which = shift || 'article';
        return $acts->{$which} && $acts->{$which}->('titleImage')
      },
-     title =>
-     sub {
-       my $which = shift || 'article';
-       $acts->{$which} && $acts->{$which}->('titleImage')
-         ? qq!<img src="/images/titles/!.$acts->{$which}->('titleImage')
-           .qq!" border="0" />! 
-         : $acts->{$which}->('title');
-     },
+     title => [ \&tag_title, $article, \@images ],
      thumbnail =>
      sub {
        my ($which, $class) = split ' ', $_[0];
@@ -373,25 +423,18 @@ HTML
        else {
         $im = $images[$image_index];
        }
-       my $html;
-       if ($align && exists $im->{$align}) {
-        $html = escape_html($im->{$align});
-       }
-       else {
-        $html = qq!<img src="/images/$im->{image}" width="$im->{width}"!
-          . qq! height="$im->{height}" alt="! . escape_html($im->{alt})
-            . qq!"!;
-        $html .= qq! align="$align"! if $align && $align ne '-';
-         unless (defined($rest) && $rest =~ /\bborder=/i) {
-           $html .= ' border="0"';
-         }
-         $html .= " $rest" if defined $rest;
-        $html .= qq! />!;
-        if ($im->{url}) {
-          $html = qq!<a href="$im->{url}">$html</a>!;
-        }
-       }
-       return $html;
+
+       return _format_image($im, $align, $rest);
+     },
+     imagen => 
+     sub {
+       my ($name, $align, $rest) = split ' ', $_[0], 3;
+
+       $had_image_tags = 1;
+       my ($im) = grep lc $name eq lc $_->{name}, @images
+        or return '';
+
+       _format_image($im, $align, $rest);
      },
      ifImage => sub { $_[0] >= 1 && $_[0] <= @images },
      ifImages => sub { @images },
index 4ca07d5..8654848 100644 (file)
@@ -6,7 +6,7 @@ use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row/;
 
 sub columns {
-  return qw/id articleId image alt width height url displayOrder/;
+  return qw/id articleId image alt width height url displayOrder name/;
 }
 
 1;
index d882290..c329628 100644 (file)
@@ -10,6 +10,92 @@ Maybe I'll add some other bits here.
 
 =head1 CHANGES
 
+=head2 0.13_01
+
+Time to get a little adventurous.
+
+=over
+
+=item *
+
+images can now have an identifier associated with them.  This can be
+used by the body text image[] tag to reference an image by name.
+
+=item *
+
+the C<< <:imagen >> I<imagename> I<alignment> I<rest> C<< :> >> tag
+can be used to insert images by name.
+
+=item *
+
+body text formatting is now based on the DevHelp::Formatter module.
+
+=item *
+
+b[], i[], tt[], font[], fontcolor[] over paragraph breaks are now
+closed properly at the paragraph breaks.
+
+=item *
+
+newlines within pre[] are no-longer converted to paragraph or line
+breaks.  As a consequence of this you can't nest character formatting
+within each other within pre[text], ie pre[b[foo]] is ok, but
+pre[b[i[foo]]] won't work.
+
+=item *
+
+the width and height parameters to the hr[] markup weren't handled
+correctly.
+
+=item *
+
+the row options to the table[] tag were inserted HTML escaped, so:
+
+  tr[...
+  bgcolor="black"|col|...
+  ]
+
+produced a tr tag like:
+
+  <tr bgcolor=&quot;black&quot>...
+
+=item *
+
+list items in ** or ## lists are now closed with </li>
+
+=item *
+
+we now put newlines between lines and paragraphs in the output of
+formatted text, hopefully this will make it easier to read the source.
+
+=item *
+
+<:error_img:> now accepts a [...] format expression to get the field
+name
+
+=item *
+
+the <:recipient_count:> tag is now available on the subscription
+listing page.  This is used for display, and to hide the Send option
+if the subscription has no recipients.
+
+=item *
+
+it's now possible to format the output of the subscription send
+process by changing the C<admin/subs/sending.tmpl> template
+
+=item *
+
+if an article has an image with an identifier of C<bse_title> then it
+will be used as the title image for the article.
+
+=item *
+
+you should be able to use one level of nested [] inside [] expressions
+in tags now
+
+=back
+
 =head2 0.13
 
 No changes since 0.12_31.
index e445c5a..cae0638 100644 (file)
@@ -45,6 +45,20 @@ URL.</p>
 
 </div>
 
+<div>
+  <h2><a name="name"></a>Identifier</h2>
+
+<p>This can be used to retrieve an article image by name with either
+body markup or in templatess.  This can be either empty, or start with
+a letter and contain only letters and number.  Each image name for an
+article must be unique to that article.</p>
+
+<p>The special identifier <code>bse_title</code> will treat the image
+as an article title image, ie. the image will be displayed instead of
+the title of the image.</p>
+
+</div>
+
 <div>
   <h2><a name="position"></a>First image position</h2>
 
@@ -60,5 +74,4 @@ href="body.html">body text markup</a> and look for
 &quot;image[<i>index</i>]&quot;.</p>
 
 </div>
-
 </body></html>
\ No newline at end of file
index 36d12bd..2ea946b 100644 (file)
             </td>
             <td nowrap bgcolor="#FFFFFF"><:help image url:> <:error_img url:></td>
           </tr>
+          <tr> 
+            <th bgcolor="#FFFFFF" align="left">Identifier for image:</th>
+            <td bgcolor="#FFFFFF"> 
+              <input type="text" name="name" value="<:old name:>">
+            </td>
+            <td nowrap bgcolor="#FFFFFF"><:help image name:> <:error_img name:></td>
+          </tr>
           <tr> 
             <td bgcolor="#FFFFFF" colspan="3" align="right"> 
               <input type="submit" name="addimg" value="Add Image">
       <td>
         <table width="100%" border="0" cellpadding="6" cellspacing="1">
           <:if Images:><tr> 
-            <th valign="top" bgcolor="#FFFFFF" colspan="4">First Image Position</th>
+            <th valign="top" bgcolor="#FFFFFF" colspan="5">First Image Position</th>
           </tr>
                  <tr> 
-            <td bgcolor="#FFFFFF" colspan="4"> 
+            <td bgcolor="#FFFFFF" colspan="5"> 
               <table width="100%" border="0" cellspacing="0" cellpadding="0">
                 <tr>
                   <td width="100%" align="center"><input type="radio" name="imagePos" value="tl" <: ifEq [article imagePos] "tl":>checked<:or:><:eif:>
            </td>
           </tr>
           <tr bgcolor="#FFFFFF"> 
-            <th colspan="4">Image</th>
+            <th colspan="5">Image</th>
           </tr>
           <: iterator begin images :> 
           <tr bgcolor="#FFFFFF"> 
-            <td align="center" colspan="4"> <img src="/images/<: image image :>" alt="<: image alt :>" width="<: 
+            <td align="center" colspan="5"> <img src="/images/<: image image :>" alt="<: image alt :>" width="<: 
               image width :>" height="<: image height :>"></td>
           </tr>
           <tr bgcolor="#FFFFFF"> 
             <th> Alt Text</th>
             <th width="50%"> URL</th>
+            <th> Identifier</th>
             <th nowrap> Modify</th>
                        <th nowrap> Move</th>
           </tr>
             <td valign="top" width="50%"> 
               <:ifUserCan edit_images_save:article:><input type="text" name="url" value="<: image url :>" size="32"><:or:><: image url :><:eif:>
             </td>
+            <td valign="top" nowrap> 
+              <:ifUserCan edit_images_save:article:><input type="text" name="name<:image_index:>" value="<: image name :>" size="32"> <:error_img [concatenate "name" [image_index] ]:><:or:><: image name :><:eif:>
+            </td>
             <td valign="bottom" nowrap> 
               <:ifUserCan edit_images_delete:article:><b><a href="<:script:>?id=<:article id:>&removeimg_<: image id :>=1&_t=img" onClick="return window.confirm('Are you sure you want to delete this Image')">Delete</a></b><:or:><:eif:></td>
             <td><:imgmove:></td>
           </tr>
           <: iterator separator images :> 
           <tr bgcolor="#FFFFFF"> 
-            <td colspan="4">&nbsp;</td>
+            <td colspan="5">&nbsp;</td>
           </tr>
           <: iterator end images :> 
 <:ifUserCan edit_images_save:article:>
           <tr> 
-            <td align="right" bgcolor="#FFFFFF" colspan="4"> 
+            <td align="right" bgcolor="#FFFFFF" colspan="5"> 
               <input type="submit" name="process" value="Save changes">
             </td>
          </tr>
 <:or:><:eif:>
-                 <:or Images:><tr><td colspan="4" align="center" bgcolor="#FFFFFF">No images
+                 <:or Images:><tr><td colspan="5" align="center" bgcolor="#FFFFFF">No images
                      are attached to this article</td>
           </tr><:eif Images:>
         </table>
index a63bd66..99fb43e 100644 (file)
@@ -14,7 +14,7 @@
 
 <:ifMessage:><p><b><:message:></b></p><:or:><:eif:>
 
-<p>| <a href="/admin/">Admin menu</a> |</p>
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> |</p>
 
 <table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" class="table">
     <tr>
@@ -26,6 +26,7 @@
       <th>Frequency</th>
       <th>Visible</th>
       <th>Last published</th>
+      <th># Recipients</th>
           <th>Modify</th>
     </tr>
 <:if Subscriptions:>
       <td><:subscription frequency:></td>
       <td align="center"><:ifSubscription visible:>Yes<:or:>No<:eif:></td>
       <td align="center"><:ifMatch [subscription lastSent] "0000-00-00":>Never<:or:><:date subscription lastSent:><:eif:></td>
+      <td align="center"><:recipient_count:></td>
           <td nowrap> <:ifUserCan subs_edit:><a href="<:script:>?edit=1&id=<:subscription id:>"><b>Edit</b></a> <:or:><:eif:>
             <:ifUserCan subs_delete:><a href="<:script:>?delconfirm=1&id=<:subscription id:>"><b>Delete</b></a>  <:or:><:eif:>
-            <:ifUserCan subs_send:><a href="<:script:>?start_send=1&id=<:subscription id:>"><b>Send</b></a>  <:or:><:eif:>
+            <:ifAnd [ifUserCan subs_send] [recipient_count]:><a href="<:script:>?start_send=1&id=<:subscription id:>"><b>Send</b></a>  <:or:><:eif:>
           </td>
     </tr>
 <:iterator end subscriptions:>
 <:or Subscriptions:>
     <tr bgcolor="#FFFFFF">
-      <td colspan="6" align="center">You don't have any subscriptions defined</td>
+      <td colspan="7" align="center">You don't have any subscriptions defined</td>
     </tr>
 <:eif Subscriptions:>
   </table>
diff --git a/site/templates/admin/subs/sending.tmpl b/site/templates/admin/subs/sending.tmpl
new file mode 100644 (file)
index 0000000..829da6f
--- /dev/null
@@ -0,0 +1,36 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+
+  <title>Administration - Subscriptions Manager</title>
+
+  <link rel="stylesheet" type="text/css" href="/css/admin.css" />
+
+</head>
+
+<body>
+
+<h1>Sending Subscription <:subscription name:></h1>
+
+<p>Hitting Stop, your browser Back button, or Refresh on this page may
+result in incomplete, or duplicate transmissions.</p>
+
+<ul>
+<:iterator begin messages:>
+<:if Error:>
+<li><b><:message:> sending to <:user email:></b></li>
+<:or Error:>
+<:if User:>
+<li>Sending to: <:user email:></li>
+<:or User:>
+<li><:message:></li>
+<:eif User:>
+<:eif Error:>
+<:iterator end messages:>
+</ul>
+
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> |</p>
+
+<p><font size="-1">BSE Release <:release:></font></p>
+</body>
+</html>
diff --git a/t/t050format.t b/t/t050format.t
new file mode 100644 (file)
index 0000000..35f2d3d
--- /dev/null
@@ -0,0 +1,154 @@
+#!perl -w
+use strict;
+use Test::More tests => 36;
+
+sub format_test($$$;$);
+
+my $gotmodule = require_ok('DevHelp::Formatter');
+
+SKIP: {
+  skip "couldn't load module", 35 unless $gotmodule;
+
+  format_test <<IN, <<OUT, 'bold', 'both';
+b[hello]
+IN
+<b>hello</b>
+OUT
+  format_test 'i[hello]', '<i>hello</i>', 'italic';
+  format_test 'b[i[hello]]', '<b><i>hello</i></b>', 'bold/italic';
+  format_test <<IN, <<OUT, 'bold over lines', 'both';
+b[hello
+foo]
+IN
+<b>hello<br />
+foo</b>
+OUT
+  format_test <<IN, <<OUT, 'bold over paras', 'both';
+b[hello
+
+foo]
+IN
+<b>hello</b></p>
+<p><b>foo</b>
+OUT
+  format_test <<IN, <<OUT, 'combo over paras', 'both';
+i[b[hello
+
+foo
+
+bar]]
+IN
+<i><b>hello</b></i></p>
+<p><i><b>foo</b></i></p>
+<p><i><b>bar</b></i>
+OUT
+  format_test <<IN, <<OUT, 'link', 'both';
+link[http://foo/|bar]
+IN
+<a href="http://foo/">bar</a>
+OUT
+  format_test 'tt[hello]', '<tt>hello</tt>', 'tt';
+  format_test 'font[-1|text]', '<font size="-1">text</font>', 'fontsize';
+  format_test 'fontcolor[-1|black|text]', '<font size="-1" color="black">text</font>', 'fontsizecolor';
+  format_test 'anchor[somename]', '<a name="somename"></a>', 'anchor';
+  format_test <<IN, <<OUT, 'pre', 'both';
+pre[hello there
+Joe]
+IN
+hello there
+Joe
+OUT
+  format_test <<IN, <<OUT, 'pre with bold', 'both';
+pre[b[hello there
+
+Joe]]
+IN
+<b>hello there</b>
+
+<b>Joe</b>
+OUT
+  format_test <<IN, <<OUT, 'html', 'both';
+html[<object foo="bar" />]
+IN
+<object foo="bar" />
+OUT
+
+  format_test 'embed[foo]', '', 'embed1';
+  format_test 'embed[foo,bar]', '', 'embed2';
+  format_test 'embed[foo,bar,quux]', '', 'embed3';
+  format_test 'h1[|text]', '<h1>text</h1>', 'h1';
+  format_test 'h1[someclass|text]', '<h1 class="someclass">text</h1>', 'h1class';
+  format_test 'h6[|te>xt]', '<h6>te&gt;xt</h6>', 'h6';
+  format_test 'align[left|some text]', '<div align="left">some text</div>', 'align';
+  format_test 'hr[]', '<hr />', 'hr0';
+  format_test 'hr[80%]', '<hr width="80%" />', 'hr1';
+  format_test 'hr[80%|10]', '<hr width="80%" height="10" />', 'hr2';
+  format_test <<IN, <<OUT, 'table1', 'both';
+table[80%
+bgcolor="black"|quux|blarg
+|hello|there
+]
+IN
+<table width="80%"><tr bgcolor="black"><td>quux</td><td>blarg</td></tr><tr><td>hello</td><td>there</td></tr></table>
+OUT
+  format_test <<IN, <<OUT, 'table2', 'both';
+table[80%|#808080|2|2|Arial
+bgcolor="black"|quux|blarg
+|hello|there
+]
+IN
+<table width="80%" bgcolor="#808080" cellpadding="2"><tr bgcolor="black"><td><font size="2" face="Arial">quux</font></td><td><font size="2" face="Arial">blarg</font></td></tr><tr><td><font size="2" face="Arial">hello</font></td><td><font size="2" face="Arial">there</font></td></tr></table>
+OUT
+  format_test <<IN, <<OUT, 'table3', 'both';
+table[80%|foo]
+IN
+<table width="80%"><tr><td>foo</td></tr></table>
+OUT
+  format_test <<IN, <<OUT, 'ol1', 'both';
+## one
+## two
+IN
+<ol><li>one</li><li>two</li></ol>
+OUT
+  format_test <<IN, <<OUT, 'ol2', 'both';
+## one
+
+## two
+IN
+<ol><li>one<br /><br /></li><li>two</li></ol>
+OUT
+  format_test <<IN, <<OUT, 'ul1', 'both';
+** one
+** two
+IN
+<ul><li>one</li><li>two</li></ul>
+OUT
+  format_test <<IN, <<OUT, 'ul2', 'both';
+** one
+
+** two
+IN
+<ul><li>one<br /><br /></li><li>two</li></ul>
+OUT
+
+  format_test 'indent[text]', '<ul>text</ul>', 'indent';
+  format_test 'center[text]', '<center>text</center>', 'center';
+  format_test 'hrcolor[80|10|#FF0000]', <<OUT, 'hrcolor', 'out';
+<table width="80" height="10" border="0" bgcolor="#FF0000" cellpadding="0" cellspacing="0"><tr><td><img src="/images/trans_pixel.gif" width="1" height="1" /></td></tr></table>
+OUT
+  format_test 'image[foo]', '', 'image';
+}
+
+sub format_test ($$$;$) {
+  my ($in, $out, $desc, $stripnl) = @_;
+
+  $stripnl ||= 'none';
+  $in =~ s/\n$// if $stripnl eq 'in' || $stripnl eq 'both';
+  $out =~ s/\n$// if $stripnl eq 'out' || $stripnl eq 'both';
+
+  my $formatter = DevHelp::Formatter->new;
+
+  my $result = $formatter->format($in);
+
+  is($result, $out, $desc);
+}
index 53342ab..944577e 100644 (file)
@@ -117,10 +117,12 @@ template_test "concatenate", $top, <<TEMPLATE, <<EXPECTED;
 <:concatenate one two:>
 <:concatenate one "two " three:>
 <:concatenate one [concatenate "two " three]:>
+<:concatenate [concatenate "one" [concatenate "two" "three"]]:>
 TEMPLATE
 onetwo
 onetwo three
 onetwo three
+onetwothree
 EXPECTED
 
 template_test "match", $top, <<'TEMPLATE', <<EXPECTED;