0.15_02 commit r0_15_02
authorTony Cook <tony@develop-help.com>
Thu, 25 Nov 2004 02:21:57 +0000 (02:21 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Thu, 25 Nov 2004 02:21:57 +0000 (02:21 +0000)
27 files changed:
MANIFEST
Makefile
site/cgi-bin/admin/reorder.pl
site/cgi-bin/admin/shopadmin.pl
site/cgi-bin/bse.cfg
site/cgi-bin/fmail.pl [new file with mode: 0755]
site/cgi-bin/modules/BSE/Edit/Catalog.pm
site/cgi-bin/modules/BSE/Edit/Product.pm
site/cgi-bin/modules/BSE/Request.pm
site/cgi-bin/modules/BSE/UI/Formmail.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Util/Tags.pm
site/cgi-bin/modules/DevHelp/Formatter.pm
site/cgi-bin/modules/DevHelp/Validate.pm
site/cgi-bin/modules/Generate.pm
site/cgi-bin/modules/Generate/Article.pm
site/cgi-bin/modules/Generate/Catalog.pm
site/docs/.cvsignore
site/docs/bse.pod
site/docs/formmail.pod [new file with mode: 0644]
site/docs/makedocs
site/templates/admin/product_list.tmpl
site/templates/common/default.tmpl
site/templates/formmail/defdone_base.tmpl [new file with mode: 0644]
site/templates/formmail/defemail.tmpl [new file with mode: 0644]
site/templates/formmail/defquery_base.tmpl [new file with mode: 0644]
t/t21gencat.t [new file with mode: 0644]
test.cfg

index 4ed3cbc..e5b8953 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -32,6 +32,7 @@ site/cgi-bin/admin/subadmin.pl
 site/cgi-bin/admin/subs.pl
 site/cgi-bin/admin/userlist.pl
 site/cgi-bin/bse.cfg
+site/cgi-bin/fmail.pl
 site/cgi-bin/interest.pl
 site/cgi-bin/modules/AdminUtil.pm
 site/cgi-bin/modules/Apache/Session/DBIreal.pm
@@ -100,6 +101,7 @@ site/cgi-bin/modules/BSE/Thumb/Imager.pm
 site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
 site/cgi-bin/modules/BSE/UI/Affiliate.pm
 site/cgi-bin/modules/BSE/UI/Dispatch.pm
+site/cgi-bin/modules/BSE/UI/Formmail.pm
 site/cgi-bin/modules/BSE/UI/SiteuserCommon.pm
 site/cgi-bin/modules/BSE/UI/SubAdmin.pm
 site/cgi-bin/modules/BSE/UserReg.pm
@@ -317,6 +319,9 @@ site/templates/custom/order_detail_payment.include
 site/templates/custom/payment_type_email.include
 site/templates/error.tmpl
 site/templates/extras.txt
+site/templates/formmail/defdone_base.tmpl
+site/templates/formmail/defemail.tmpl
+site/templates/formmail/defquery_base.tmpl
 site/templates/helpicon.tmpl   Help icon for user templates
 site/templates/htmlemail/basic.tmpl
 site/templates/include/rssitems.tmpl
@@ -383,6 +388,7 @@ t/t060parms.t
 t/t070sqldates.t       Test SQL date tools
 t/t10edit.t
 t/t20gen.t
+t/t21gencat.t  Tests catalog generation
 t/t30rules.t   Check for use strict and warnings
 t/t40images.t  Tests image management
 t/t50subscalc.t        Test subscriptions calculations
index ee8fffd..fb44be2 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.15_01
+VERSION=0.15_02
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
index 53a4bfb..78c844e 100755 (executable)
@@ -63,6 +63,10 @@ if ($req->user_can(edit_reorder_children => $parentid)) {
     }
   }
   
+  my $type = $cgi->param('type');
+  if ($type) {
+    @kids = grep { $_->[0]{generator} =~ /::\Q$type\E$/, @kids;
+  }
   
   my @order = sort { $b <=> $a } map $_->[1]{$_->[2]}, @kids;
   my $sort = join(",", $cgi->param('sort')) || 'current';
index c709c96..3c87aab 100755 (executable)
@@ -18,7 +18,8 @@ use Constants qw(:shop $SHOPID $PRODUCTPARENT
 use Images;
 use Articles;
 use BSE::Sort;
-use BSE::Util::Tags;
+use BSE::Util::Tags qw(tag_hash);
+use BSE::Util::Iterate;
 use BSE::Request;
 use BSE::WebUtil 'refresh_to_admin';
 use DevHelp::HTML;
@@ -189,17 +190,24 @@ sub product_list {
   my $cgi = $req->cgi;
   my $session = $req->session;
   my $shopid = $req->cfg->entryErr('articles', 'shop');
+  my $shop = Articles->getByPkey($shopid);
   my @catalogs = sort { $b->{displayOrder} <=> $a->{displayOrder} }
-    Articles->children($shopid);
+    grep $_->{generator} eq 'Generate::Catalog', Articles->children($shopid);
   my $catalog_index = -1;
   $message ||= $cgi->param('m') || $cgi->param('message') || '';
   if (defined $cgi->param('showstepkids')) {
     $session->{showstepkids} = $cgi->param('showstepkids');
   }
   exists $session->{showstepkids} or $session->{showstepkids} = 1;
+  my $products = Products->new;
+  my @products = sort { $b->{displayOrder} <=> $a->{displayOrder} }
+    $products->getBy(parentid => $shopid);
+  my $product_index;
 
   my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
 
+  my $it = BSE::Util::Iterate->new;
+
   my %acts;
   %acts =
     (
@@ -209,6 +217,7 @@ sub product_list {
      catalog=> sub { CGI::escapeHTML($catalogs[$catalog_index]{$_[0]}) },
      iterate_catalogs => sub { ++$catalog_index < @catalogs  },
      shopid=>sub { $shopid },
+     shop => [ \&tag_hash, $shop ],
      script=>sub { $ENV{SCRIPT_NAME} },
      message => sub { $message },
      embed =>
@@ -240,6 +249,39 @@ sub product_list {
        return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
      },
      ifShowStepKids => sub { $session->{showstepkids} },
+     $it->make_iterator(undef, 'product', 'products', \@products, \$product_index),
+     move =>
+     sub {
+       my ($arg, $acts, $funcname, $templater) = @_;
+
+       $req->user_can(edit_reorder_children => $shop)
+        or return '';
+       my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
+       defined $img_prefix or $img_prefix = '';
+       defined $urladd or $urladd = '';
+       @products > 1 or return '';
+       # links to move products up/down
+       my $refreshto = $ENV{SCRIPT_NAME}."$urladd#cat".$shop->{id};
+       my $down_url = '';
+       if ($product_index < $#products) {
+        if ($session->{showstepkids}) {
+          $down_url = "$CGI_URI/admin/move.pl?stepparent=$shop->{id}&d=swap&id=$products[$product_index]{id}&other=$products[$product_index+1]{id}";
+        }
+        else {
+          $down_url = "$CGI_URI/admin/move.pl?id=$products[$product_index]{id}&d=swap&other=$products[$product_index+1]{id}";
+        }
+       }
+       my $up_url = '';
+       if ($product_index > 0) {
+        if ($session->{showstepkids}) {
+          $up_url = "$CGI_URI/admin/move.pl?stepparent=$shop->{id}&d=swap&id=$products[$product_index]{id}&other=$products[$product_index-1]{id}";
+        }
+        else {
+          $up_url = "$CGI_URI/admin/move.pl?id=$products[$product_index]{id}&d=swap&other=$products[$product_index-1]{id}";
+        }
+       }
+       return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
+     },
     );
 
   page('product_list', \%acts);
index 427c800..7398f14 100644 (file)
@@ -42,6 +42,8 @@ user/userpage.tmpl = user,user/userpage_base.tmpl
 interest/confirm.tmpl = interest,interest/confirm_base.tmpl
 interest/askagain.tmpl = interest,interest/askagain_base.tmpl
 interest/error.tmpl = interest,interest/error_base.tmpl
+formmail/defquery.tmpl = formmail,formmail/defquery_base.tmpl
+formmail/defdone.tmpl = formmail,formmail/defdone_base.tmpl
 
 [user settings]
 title = My $(site/name)
@@ -49,6 +51,9 @@ title = My $(site/name)
 [interest settings]
 title = $(site/name) Interest Registration
 
+[formmail settings]
+title = Send us a comment
+
 [messages]
 user/notyourorder = Order $1 isn't your order
 shop/fileitems = You have products in your cart that include downloadable files.  Please logon or register before checking out.
diff --git a/site/cgi-bin/fmail.pl b/site/cgi-bin/fmail.pl
new file mode 100755 (executable)
index 0000000..002165b
--- /dev/null
@@ -0,0 +1,18 @@
+#!/usr/bin/perl -w -d:ptkdb
+BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0' }
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/modules";
+use BSE::DB;
+use BSE::Request;
+use BSE::Template;
+use Carp 'confess';
+use BSE::UI::Formmail;
+
+$SIG{__DIE__} = sub { confess $@ };
+
+my $req = BSE::Request->new;
+
+my $result = BSE::UI::Formmail->dispatch($req);
+
+BSE::Template->output_result($req, $result);
index 3f1c98b..fac07fe 100644 (file)
@@ -65,12 +65,14 @@ sub possible_parents {
   my @work = [ $shopid, $shop->{title} ];
   while (@work) {
     my ($id, $title) = @{pop @work};
-    push(@values, $id);
-    $labels{$id} = $title;
-    push @work, map [ $_->{id}, $title.' / '.$_->{title} ],
-    sort { $b->{displayOrder} <=> $a->{displayOrder} }
-      grep $_->{generator} eq 'Generate::Catalog', 
-      $articles->getBy(parentid=>$id);
+    if (!$article->{id} || $article->{id} != $id) {
+      push(@values, $id);
+      $labels{$id} = $title;
+      push @work, map [ $_->{id}, $title.' / '.$_->{title} ],
+       sort { $b->{displayOrder} <=> $a->{displayOrder} }
+         grep $_->{generator} eq 'Generate::Catalog', 
+           $articles->getBy(parentid=>$id);
+    }
   }
 
   return (\@values, \%labels);
index 326ae87..e13d658 100644 (file)
@@ -205,8 +205,10 @@ sub possible_parents {
       grep $_->{generator} eq 'Generate::Catalog', 
       $articles->getBy(parentid=>$id);
   }
-  shift @values;
-  delete $labels{$shopid};
+  unless ($shop->{generator} eq 'Generate::Catalog') {
+    shift @values;
+    delete $labels{$shopid};
+  }
   return (\@values, \%labels);
 }
 
index ab026b7..1e14835 100644 (file)
@@ -174,6 +174,36 @@ sub dyn_response {
                                    $base_template);
 }
 
+sub response {
+  my ($req, $template, $acts) = @_;
+
+  return BSE::Template->get_response($template, $req->cfg, $acts);
+}
+
+# get the current site user if one is logged on
+sub siteuser {
+  my ($req) = @_;
+
+  my $cfg = $req->cfg;
+  my $session = $req->session;
+  require SiteUsers;
+  if ($cfg->entryBool('custom', 'user_auth')) {
+    require BSE::CfgInfo;
+    my $custom = BSE::CfgInfo::custom_class($cfg);
+    
+    return $custom->siteuser_auth($session, $req->cgi, $cfg);
+  }
+  else {
+    my $userid = $session->{userid}
+      or return;
+    my $user = SiteUsers->getBy(userId=>$userid)
+      or return;
+    $user->{disabled}
+      and return;
+    return $user;
+  }
+}
+
 sub DESTROY {
   my ($self) = @_;
   if ($self->{session}) {
diff --git a/site/cgi-bin/modules/BSE/UI/Formmail.pm b/site/cgi-bin/modules/BSE/UI/Formmail.pm
new file mode 100644 (file)
index 0000000..beaf381
--- /dev/null
@@ -0,0 +1,189 @@
+package BSE::UI::Formmail;
+use strict;
+use base qw(BSE::UI::Dispatch);
+use BSE::Util::Tags qw(tag_hash tag_error_img);
+use DevHelp::HTML;
+use DevHelp::Validate qw(dh_validate dh_configure_fields);
+use BSE::Util::Iterate;
+use constant DISPLAY_TIMEOUT => 300;
+
+my %actions =
+  (
+   show => 1,
+   send => 1,
+   done => 1,
+  );
+
+sub actions { \%actions }
+
+sub default_action { 'show' }
+
+my %def_rules =
+  (
+   from => { rules=>'email', description=>"Your email address", required=>1,
+          width=>60},
+   subject => { description => "Subject", required=>1, width=>60 },
+   text => { description => "Your query", required=>1,
+          htmltype=>"textarea", width=>60, height=>10 },
+  );
+
+my %form_defs =
+  (
+   query => 'formmail/defquery',
+   done => 'formmail/defdone',
+   mail => 'formmail/defemail',
+   fields => 'from,subject,text',
+   subject => 'User form emailed',
+  );
+
+
+sub _get_form {
+  my ($req) = @_;
+
+  my $cfg = $req->cfg;
+
+  my $id = $req->cgi->param('form') || 'default';
+
+  my $section = "$id form";
+
+  my %form;
+  
+  for my $field (keys(%form_defs), "email") {
+    $form{$field} = $cfg->entry($section, $field, $form_defs{$field});
+  }
+
+  unless ($form{email}) {
+    $form{email} = $cfg->entry('shop', 'from', $Constants::SHOP_FROM)
+      or die "No email configured for form $id, and no default available\n";
+  }
+
+  my %fields;
+  my @names = split /,/, $form{fields};
+  for my $form_field (@names) {
+    $fields{$form_field} = $def_rules{$form_field} || 
+      { description => "\u$form_field" };
+  }
+
+  my $fields = dh_configure_fields(\%fields, $cfg, "$id formmail validation");
+  $fields->{$_}{name} = $_ for keys %$fields;
+
+  $form{validation} = $fields;
+  $form{fields} = [ @$fields{@names} ];
+  $form{id} = $id;
+
+  \%form;
+}
+
+sub req_show {
+  my ($class, $req, $errors) = @_;
+
+  my $form = _get_form($req);
+
+  my $msg = $req->message($errors);
+
+  my $it = BSE::Util::Iterate->new;
+  my %acts;
+  %acts =
+    (
+     BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+     error_img => [ \&tag_error_img, $req->cfg, $errors ],
+     $it->make_iterator(undef, 'field', 'fields', $form->{fields}),
+     msg => $msg,
+     id => $form->{id},
+    );
+
+  return $req->response($form->{query}, \%acts);
+}
+
+sub req_send {
+  my ($class, $req) = @_;
+
+  my $form = _get_form($req);
+
+  my $cgi = $req->cgi;
+  my $cfg = $req->cfg;
+
+  my %form = ( fields =>$form->{validation}, rules=>{} );
+
+  my %errors;
+  dh_validate($cgi, \%errors, \%form); # already configured
+
+  keys %errors
+    and return $class->req_show($req, \%errors);
+
+  # grab our values
+  my %values;
+  for my $field (@{$form->{fields}}) {
+    $field->{value} = $values{$field->{name}} = 
+      join '', $cgi->param($field->{name});
+  }
+
+  # send an email
+  my $user = $req->siteuser;
+  my $it = BSE::Util::Iterate->new;
+  my %acts;
+  %acts =
+    (
+     BSE::Util::Tags->static(\%acts, $cfg),
+     ifUser=>!!$user,
+     user => $user ? [ \&tag_hash, $user ] : '',
+     value => [ \&tag_hash, \%values ],
+     $it->make_iterator(undef, 'field', 'fields', $form->{fields}),
+     id => $form->{id},
+    );
+
+  require BSE::Mail;
+  my $mailer = BSE::Mail->new(cfg=>$cfg);
+  my $content = BSE::Template->get_page($form->{mail}, $cfg, \%acts);
+  unless ($mailer->send(to=>$form->{email}, from=>$form->{email},
+                       subject=>$form->{subject}, body=>$content)) {
+    print STDERR "Error sending mail: ", $mailer->errstr, "\n";
+    $errors{_mail} = $mailer->{errstr};
+    return $class->req_show($req, \%errors);
+  }
+
+  # make them available to the a_sent handler
+  my $session = $req->session;
+  $session->{formmail} = \%values;
+  $session->{formmail_done} = time;
+
+  my $url = $ENV{SCRIPT} . "?a_done=1&form=$form->{id}&t=".$session->{formmail_done};
+
+  return BSE::Template->get_refresh($url, $cfg);
+}
+
+sub req_done {
+  my ($class, $req) = @_;
+
+  my $form = _get_form($req);
+
+  my $session = $req->session;
+  $session->{formmail} && $session->{formmail_done}
+    or return $class->req_show($req);
+    
+  my $time = $req->cgi->param('t');
+  $time == $session->{formmail_done}
+    or return $class->req_show($req);
+
+  my $now = time;
+  $now <= $time + DISPLAY_TIMEOUT
+    or return $class->req_show($req);
+
+  my $values = $session->{formmail};
+  for my $field (@{$form->{fields}}) {
+    $field->{value} = $values->{$field->{name}};
+  }
+  my $it = BSE::Util::Iterate->new;
+  my %acts;
+  %acts =
+    (
+     BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+     $it->make_iterator(undef, 'field', 'fields', $form->{fields}),
+     id => $form->{id},
+     value => [ \&tag_hash, $values ],
+    );
+
+  return $req->response($form->{done}, \%acts);
+}
+
+1;
index eae92d3..eda94e9 100644 (file)
@@ -346,7 +346,8 @@ sub tag_nobodytext {
 sub tag_old {
   my ($cgi, $args, $acts, $name, $templater) = @_;
 
-  my ($field, $func, $funcargs) = split ' ', $args, 3;
+  my ($field, $func, $funcargs) = 
+    DevHelp::Tags->get_parms($args, $acts, $templater);
 
   my $value = $cgi->param($field);
   if (defined $value) {
@@ -401,6 +402,7 @@ sub basic {
      old => [ \&tag_old, $cgi ],
      oldi => [ \&tag_oldi, $cgi ],
      $it->make_iterator(\&DevHelp::Tags::iter_get_repeat, 'repeat', 'repeats'),
+     dynreplace => \&tag_replace,
     );
 }
 
index 57ce380..8e2c132 100644 (file)
@@ -221,6 +221,8 @@ sub format {
          and next TRY;
        $part =~ s#h([1-6])\[\|([^\[\]]+)\](?:\r?\n)?#<h$1>$2</h$1>#ig
           and next TRY;
+       $part =~ s#div\[([^\[\]\|]+)\|([^\[\]]+)\]#<div class="$1">$2</div>#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
@@ -252,6 +254,9 @@ sub format {
        last;
       }
       $part =~ s!(\n([ \r]*\n)*)!$1 eq "\n" ? "<br />\n" : "</p>\n<p>"!eg;
+      $part = "<p>$part</p>";
+      $part =~ s/<p><div class=\"([^\"]+)\">/<div class="$1"><p>/g;
+      $part =~ s!</div></p>!</p></div>!g;
       #$part =~ s!\n!<br />!g;
       $out .= $part;
     }
@@ -292,6 +297,8 @@ sub remove_format {
     TRY: while (1) {
        $self->remove(\$part)
          and next TRY;
+       $part =~ s#div\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#$2#ig
+          and next TRY;
        $part =~ s#h([1-6])\[\|([^\[\]]+)\](?:\r?\n)?#$2#ig
           and next TRY;
        $part =~ s#h([1-6])\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#$3#ig
index dfa34cb..f0f0a58 100644 (file)
@@ -2,7 +2,7 @@ package DevHelp::Validate;
 use strict;
 require Exporter;
 use vars qw(@EXPORT_OK @ISA);
-@EXPORT_OK = qw(dh_validate dh_validate_hash dh_fieldnames);
+@EXPORT_OK = qw(dh_validate dh_validate_hash dh_fieldnames dh_configure_fields);
 @ISA = qw(Exporter);
 
 sub new {
@@ -396,7 +396,7 @@ sub _get_cfg_fields {
   my @names = ( split(/,/, $fields), keys %$field_hash );
 
   for my $field (@names) {
-    for my $cfg_name (qw(required rules description required_error range_error mindatemsg maxdatemsg)) {
+    for my $cfg_name (qw(required rules description required_error range_error mindatemsg maxdatemsg htmltype type width height size)) {
       my $value = $cfg->entry($section, "${field}_$cfg_name");
       if (defined $value) {
        $cfg_fields->{$field}{$cfg_name} = $value;
@@ -405,6 +405,46 @@ sub _get_cfg_fields {
   }
 }
 
+sub dh_configure_fields {
+  my ($fields, $cfg, $section) = @_;
+
+  my %cfg_rules;
+  _get_cfg_fields(\%cfg_rules, $cfg, $section, $fields);
+
+  # **FIXME** duplicated code
+  my $cfg_fields = $cfg_rules{fields};
+  for my $field ( keys %$fields ) {
+    my $src = $fields->{$field};
+
+    my $dest = $cfg_fields->{$field} || {};
+
+    # the config overrides the software supplied fields
+    for my $override (qw(description required required_error range_error mindatemsg maxdatemsg htmltype type width height size)) {
+      if (defined $src->{$override} && !defined $dest->{$override}) {
+       $dest->{$override} = $src->{$override};
+      }
+    }
+
+    # but we add rules
+    if ($dest->{rules}) {
+      my $rules = $src->{rules};
+
+      # make a copy of the rules array if it's supplied that way so
+      # we don't modify someone else's data
+      $rules = ref $rules ? [ @$rules ] : [ split /;/, $rules ];
+
+      push @$rules, split /;/, $dest->{rules};
+    }
+    elsif ($src->{rules}) {
+      $dest->{rules} = $src->{rules};
+    }
+
+    $cfg_fields->{$field} = $dest if keys %$dest;
+  }
+
+  return $cfg_fields;
+}
+
 sub _get_cfg_rule {
   my ($self, $rulename) = @_;
 
index c8d45e4..28d3433 100644 (file)
@@ -437,11 +437,11 @@ sub baseActs {
 
      summary =>
      sub {
-       my $which = shift;
+       my ($which, $acts, $name, $templater) = @_;
        $which or $which = "child";
        $acts->{$which}
         or return "<:summary $which Cannot find $which:>";
-       my $id = $acts->{$which}->("id")
+       my $id = $templater->perform($acts, $which, "id")
         or return "<:summary $which No id returned :>";
        my $article = $articles->getByPkey($id)
         or return "<:summary $which Cannot find article $id:>";
index 26eb220..1bf6b63 100644 (file)
@@ -262,12 +262,16 @@ sub baseActs {
      title => [ \&tag_title, $article, \@images ],
      thumbnail =>
      sub {
-       my ($which, $class) = split ' ', $_[0];
+       my ($args, $acts, $name, $templater) = @_;
+       my ($which, $class) = split ' ', $args;
        $which ||= 'article';
-       if ($acts->{$which} && $acts->{$which}->('thumbImage')) {
-         my $result = '<img src="/images/'.$acts->{$which}->('thumbImage')
-           .'" width="'.$acts->{$which}->('thumbWidth')
-             .'" height="'.$acts->{$which}->('thumbHeight').'"';
+       if ($acts->{$which} && 
+          (my $image = $templater->perform($acts, $which, 'thumbImage'))) {
+        my $width = $templater->perform($acts, $which, 'thumbWidth');
+        my $height = $templater->perform($acts, $which, 'thumbHeight');
+         my $result = '<img src="/images/'.$image
+           .'" width="'.$width
+             .'" height="'.$height.'"';
          $result .= qq! class="$class"! if $class;
          $result .= ' border="0" alt="" />';
          return $result;
@@ -278,8 +282,10 @@ sub baseActs {
      },
      ifThumbnail =>
      sub {
-       my $which = shift || 'article';
-       return $acts->{$which} && $acts->{$which}->('thumbImage');
+       my ($which, $acts, $name, $templater) = @_;
+       $which ||= 'article';
+       return $acts->{$which} && 
+        $templater->perform($acts, $which, 'thumbImage');
      },
      ifUnderThreshold => 
      sub { 
index d1914a7..b860cf1 100644 (file)
@@ -10,6 +10,7 @@ use Util qw(generate_button);
 use OtherParents;
 use DevHelp::HTML;
 use BSE::Arrows;
+use BSE::Util::Iterate;
 
 sub _default_admin {
   my ($self, $article, $embedded) = @_;
@@ -62,6 +63,39 @@ HTML
   return $html;
 }
 
+sub tag_moveallcat {
+  my ($self, $allcats, $rindex, $article, $arg, $acts, $funcname, $templater) = @_;
+
+  return '' unless $self->{admin};
+  return '' unless $self->{request};
+  return '' 
+    unless $self->{request}->user_can(edit_reorder_children => $article);
+  return '' unless @$allcats > 1;
+
+  my ($img_prefix, $urladd) = 
+    DevHelp::Tags->get_parms($arg, $acts, $templater);
+  $img_prefix = '' unless defined $img_prefix;
+  $urladd = '' unless defined $urladd;
+  
+  my $can_move_up = $$rindex > 0;
+  my $can_move_down = $$rindex < $#$allcats;
+  return '' unless $can_move_up || $can_move_down;
+  my $myid = $allcats->[$$rindex]{id};
+  my $top = $self->{top} || $article;
+  my $refreshto = "$CGI_URI/admin/admin.pl?id=$top->{id}$urladd";
+  my $down_url = "";
+  if ($can_move_down) {
+    my $nextid = $allcats->[$$rindex+1]{id};
+    $down_url = "$CGI_URI/admin/move.pl?stepparent=$article->{id}&d=swap&id=$myid&other=$nextid";
+  }
+  my $up_url = "";
+  if ($can_move_up) {
+    my $previd = $allcats->[$$rindex-1]{id};
+    $up_url = "$CGI_URI/admin/move.pl?stepparent=$article->{id}&d=swap&id=$myid&other=$previd";
+  }
+  return make_arrows($self->{cfg}, $down_url, $up_url, $refreshto, $img_prefix);
+}
+
 sub generate_low {
   my ($self, $template, $article, $articles, $embedded) = @_;
 
@@ -77,27 +111,28 @@ sub generate_low {
   my $today = sprintf("%04d-%02d-%02d 00:00:00ZZZ", $year+1900, $month+1, $day);
   my @stepprods = $article->visible_stepkids;
   my $stepprod_index;
-  my @allprods = $article->all_visible_kids;
+  my @allkids = $article->all_visible_kids;
   require 'Generate/Product.pm';
-  @allprods = grep UNIVERSAL::isa($_->{generator}, 'Generate::Product'), @allprods;
+  my @allprods = grep UNIVERSAL::isa($_->{generator}, 'Generate::Product'), 
+    @allkids;
   for (@allprods) {
     unless ($_->isa('Product')) {
       $_ = Products->getByPkey($_->{id});
     }
   }
+  my @allcats = grep UNIVERSAL::isa($_->{generator}, 'Generate::Catalog'), 
+    @allkids;
   my $allprod_index;
-  my $category_index = -1;
+  my $catalog_index = -1;
+  my $allcat_index;
+  my $it = BSE::Util::Iterate->new;
   my %acts;
   %acts =
     (
      $self->baseActs($articles, \%acts, $article, $embedded),
      article => sub { escape_html($article->{$_[0]}) },
-     iterate_products =>
-     sub {
-       return ++$product_index < @products;
-     },
-     product=> sub { escape_html($products[$product_index]{$_[0]}) },
-     ifProducts => sub { @products },
+     $it->make_iterator(undef, 'product', 'products', \@products, 
+                       \$product_index),
      admin => [ tag_admin => $self, $article, 'catalog', $embedded ],
      # for rearranging order in admin mode
      moveDown=>
@@ -126,9 +161,8 @@ HTML
         return '';
        }
      },
-     iterate_allprods_reset => sub { $allprod_index = -1 },
-     iterate_allprods => sub { ++$allprod_index < @allprods },
-     allprod => sub { escape_html($allprods[$allprod_index]{$_[0]}) },
+     $it->make_iterator(undef, 'allprod', 'allprods', \@allprods, 
+                       \$allprod_index),
      moveallprod =>
      sub {
        my ($arg, $acts, $funcname, $templater) = @_;
@@ -163,16 +197,16 @@ HTML
        }
        return make_arrows($self->{cfg}, $down_url, $up_url, $refreshto, $img_prefix);
      },
-     ifAnyProds => sub { escape_html(@allprods) },
-     iterate_stepprods_reset => sub { $stepprod_index = -1 },
-     iterate_stepprods => sub { ++$stepprod_index < @stepprods; },
-     stepprod => sub { escape_html($stepprods[$stepprod_index]{$_[0]}) },
+     ifAnyProds => scalar(@allprods),
+     $it->make_iterator(undef, 'stepprod', 'stepprods', \@stepprods,
+                       \$stepprod_index),
      ifStepProds => sub { @stepprods },
-     iterate_catalogs_reset => sub { $category_index = -1 },
-     iterate_catalogs => sub { ++$category_index < @subcats },
-     catalog => 
-     sub { escape_html($subcats[$category_index]{$_[0]}) },
+     $it->make_iterator(undef, 'catalog', 'catalogs', \@subcats, 
+                       \$catalog_index),
      ifSubcats => sub { @subcats },
+     $it->make_iterator(undef, 'allcat', 'allcats', \@allcats, \$allcat_index),
+     moveallcat => 
+     [ \&tag_moveallcat, $self, \@allcats, \$allcat_index, $article ],
     );
   my $oldurl = $acts{url};
   my $urlbase = $self->{cfg}->entryVar('site', 'url');
index feac7e9..79dd32b 100644 (file)
@@ -21,3 +21,4 @@ BSE::UI::Affiliate.html
 affiliate.html
 future_plans.html
 thumbnails.html
+formmail.html
index a77a5ee..e870ecf 100644 (file)
@@ -10,6 +10,58 @@ Maybe I'll add some other bits here.
 
 =head1 CHANGES
 
+=head2 0.15_02
+
+=over
+
+=item *
+
+added the fmail.pl script, see formmail.pod for information on using
+this.
+
+=item *
+
+reorder.pl now accepts a type parameter to sort only those children
+that have the appropriate generator.
+
+=item *
+
+catalogs now use the standard iterator tags for products, allprods,
+stepprods, and adds an allcats iterator.
+
+=item *
+
+shopadmin.pl now supports the shop article being a catalog, adding the
+shop tag and products iterator for the base product_list template.
+
+=item *
+
+the summary and thumbnail tags didn't work with newer style article
+tags
+
+=item *
+
+the drop-down parent list for catalogs no longer includes the current
+catalog or its children.
+
+=item *
+
+you can now parent products to the shop article if it's a catalog.
+
+=item *
+
+the dynamic C<old> tag can now accept the field name as a [] parameter.
+
+=item *
+
+body text is now generated with surrounding <p> and </p> tags.
+
+=item *
+
+added the div[class|text...] formatting tag
+
+=back
+
 =head2 0.15_01
 
 =over
diff --git a/site/docs/formmail.pod b/site/docs/formmail.pod
new file mode 100644 (file)
index 0000000..1fdee19
--- /dev/null
@@ -0,0 +1,282 @@
+=head1 NAME
+
+formmail.pod - using and configuring fmail.pl
+
+=head1 SYNOPSIS
+
+  # Link
+  .../cgi-bin/fmail.pl?form=formid
+
+  # Configuration
+  [formid form]
+  fields=field1,field2,...
+  email=where.to@send.to
+  query=querytemplate
+  done=finaltemplate
+  mail=mailtemplate
+
+  [formid formmail validation]
+  field1_description=description of field1
+  field1_rules=rules...
+  field1_required=1
+  field2_description=description of field2
+  field2_rules=rules...
+
+  # and templates, not shown here
+
+=head1 DESCRIPTION
+
+fmail.pl provides the basic facilities of the original formmail.pl,
+with the following extras:
+
+=over
+
+=item *
+
+security - since the email to be sent to is stored in BSE's
+configuration, it cannot be hijacked to send email to others.
+
+=item *
+
+user information - since it's part of BSE it has access to BSE's user
+system, and can include information about the logged in member in the
+email if there is one.
+
+=item *
+
+validation - you can use the DevHelp validation engine to validate the
+fields the user enters
+
+=item *
+
+templates - the system uses BSE's templating system, allowing complete
+customization of the entry form, the final display form and the email
+sent
+
+=back
+
+=head1 INVOKING
+
+In general you want to link for fmail.pl and supply a form id:
+
+  <a href="/cgi-bin/fmail.pl?form=someform">Send us feedback</a>
+
+You can also link without a form id:
+
+  <a href="/cgi-bin/fmail.pl">Send us feedback</a>
+
+which is exactly the same as:
+
+  <a href="/cgi-bin/fmail.pl?form=default">Send us feedback</a>
+
+If you make a modified query template, make sure you supply the form
+id as a hidden field:
+
+  <input type="hidden" name="form" value="<:id:>" />
+
+During form processing, fmail.pl accepts 2 different action values:
+
+=over
+
+=item *
+
+a_send - send the email, assuming all fields pass validation.  This
+will save the form data in the session object and refresh to a_done.
+
+=item *
+
+a_done - displays the completion page, using the values stored in the
+session.  Note that this will only work for 10 minutes after
+submission to protect the users privacy.
+
+=back
+
+=head1 CONFIGURATION
+
+Each form id refers to a form configuration section and a form
+validation section of the configuration file.
+
+The configuration entries available in [I<form> form] are:
+
+=over
+
+=item *
+
+query - the name of the query template, the form used to ask the user
+for their information. Default: formmail/defquery
+
+=item *
+
+done - the name of the final display template, used to thank them for
+entering their data or say it will be responded to, or whatever this
+form is being used for. Default: formmail/defdone
+
+=item *
+
+mail - the name of the email template, used to build the content sent
+to the configured email address. Default: formmail/defemail
+
+=item *
+
+fields - a comma separated list of fields to be entered.  Default:
+from,subject,text
+
+=item *
+
+subject - the subject of the email sent. Default: User form emailed
+
+=item *
+
+email - the email address the form data is sent to.  Defaults to the
+value configured as [shop].from or $SHOP_FROM from Constants.pm
+
+=back
+
+You can also configure information used for validation and available
+to the <:field ...:> tag in the templates.  This is from the
+[I<formid> formmail validation] section.
+
+In general each entry is the name of a field (from fields above),
+followed by underscore, followed by a validation configuration name,
+for example C<from_required> is used to configure whether the C<from>
+field is required.
+
+=over
+
+=item *
+
+I<fieldname>_required - if this is non-zero the I<fieldname> is a
+required field.
+
+=item *
+
+I<fieldname>_required_error - message displayed for the field if it's
+marked required but isn't set.
+
+=item *
+
+I<fieldname>_description - a display name for the field.
+
+=item *
+
+I<fieldname>_rules - a semi-colon separated list of validation rules
+for the field.  See L<DevHelp::Validate> for a list of built-in rules,
+some common ones are C<email>, I<phone>, I<weburl>, I<date>.  You can
+also configure extra rules, with some limits.
+
+=item *
+
+I<fieldname>_htmltype - used by the default query form to choose how
+to display the field.  Values accepted are "textarea", "password", or
+"text".
+
+=item *
+
+I<fieldtype>_width - used by the default query form to set the width
+attribute for text, password and textarea fields.
+
+=item *
+
+I<fieldtype>_height - used by the default query form to set the height
+attribute for textarea fields.
+
+=back
+
+=head1 TEMPLATES
+
+fmail.pl uses three templates:
+
+=over
+
+=item *
+
+query - asks the user for their information
+
+=item *
+
+mail - sents the information to you
+
+=item 
+
+done - displayed after the information is submitted.
+
+=back
+
+Standard BSE dynamic tags are available on the query and done
+templates.  Standard BSE static tags are available on the mail
+template.
+
+These tags are available on all three templates:
+
+=over
+
+=item *
+
+id - the form id of the form
+
+=item *
+
+iterator begin fields ... iterator end fields - Iterates over the
+fields in the order specified in the fields configuration value.  Use
+the C<field> tag to get the field information.  Other standard
+iterator tags are also available, eg. field_count.
+
+=item *
+
+field I<fieldinfo> - accesses information about the field, possible
+values for I<fieldinfo> include C<required>, C<htmltype>,
+C<description> and so.
+
+On the mail and done templates I<fieldinfo> can also be C<value> to
+present the value captured from the user.
+
+=back
+
+The following tags are available on the done and mail templates:
+
+=over
+
+=item *
+
+value I<fieldname> - retrieves the value of a given field.
+
+=back
+
+The following tags are only available on the query template:
+
+=over
+
+=item *
+
+error_img I<fieldname> - displays an error icon if there was a
+validation error for that field.
+
+=item *
+
+msg - displays an error message
+
+=back
+
+The following tags are only available on the mail template:
+
+=over
+
+=item *
+
+ifUser - check if a user was logged on when the form was submitted.
+
+=item *
+
+user I<userfield> - access to the user's SiteUser record.
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=head1 REVISION
+
+$Revision$
+
+=cut
index bb57971..837a971 100644 (file)
@@ -29,6 +29,7 @@ my @targets =
    'BSE::UI::Affiliate.html',
    'future_plans.html',
    'thumbnails.html',
+   'formmail.html',
   );
 
 my @exts = qw(.pod .pm .pl);
index 347062a..707b977 100644 (file)
   ShowStepKids:><a href="<:script:>?showstepkids=0">Hide step children</a><:or 
   ShowStepKids:><a href="<:script:>?showstepkids=1">Show step children</a><:eif 
   ShowStepKids:> | </p>
+<:if Products:> 
+<h4>Products list</h4>
+<table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" width="100%" class="table">
+  <tr>
+    <td>
+      <table border=0 cellpadding="6" cellspacing="1" width="100%">
+        <tr> 
+          <th bgcolor="#FFFFFF" nowrap>Id</th>
+          <th bgcolor="#FFFFFF" width="100%">Name</th>
+          <th bgcolor="#FFFFFF" nowrap>Release</th>
+          <th bgcolor="#FFFFFF" nowrap>Expire</th>
+          <th bgcolor="#FFFFFF" nowrap>Retail</th>
+          <th bgcolor="#FFFFFF" nowrap>Wsale</th>
+          <th bgcolor="#FFFFFF" nowrap>GST</th>
+          <th bgcolor="#FFFFFF" nowrap>Modify</th>
+          <th bgcolor="#FFFFFF">Note</th>
+        </tr>
+        <:iterator begin products:> 
+        <tr bgcolor="#FFFFFF"> 
+          <td align="center" nowrap><:product id:></td>
+          <td width="100%"><a href="<:product admin:>"><:product title:></a></td>
+          <td nowrap><:date product release:></td>
+          <td nowrap><:ifMatch [product expire] "9999-12-31":>Never<:or:><:date product expire:><:eif:></td>
+          <td align=right nowrap>$<:money product retailPrice:></td>
+          <td align=right nowrap>$<:money product wholesalePrice:></td>
+          <td align=right nowrap>$<:money product gst:></td>
+          <td nowrap><a href="/cgi-bin/admin/add.pl?id=<:product id:>">Edit</a> 
+            <:if Product listed:> <a href="/cgi-bin/admin/add.pl?hide=1&id=<:product id:>&r=<:cfg site url:><:script:>">Hide</a> 
+            <:or Product:> <a href="/cgi-bin/admin/add.pl?unhide=1&id=<:product id:>&r=<:cfg site url:><:script:>">Show</a> 
+            <:eif Product:> <:move:> </td>
+          <td><:ifProduct listed:>&nbsp;<:or:>Hidden<:eif:></td>
+        </tr>
+        <:iterator end products:> 
+      </table>
+    </td>
+  </tr>
+</table>
+<:or Products:><:eif Products:>
 <:iterator begin catalogs:> <a name="cat<:catalog id:>"></a> 
 <h2>Catalog: <:catalog title:> <:movecat:></h2>
 <p><:embed catalog catalog.tmpl:></p>
 <hr noshade size="1">
 <:iterator end catalogs:> 
 <:ifUserCan edit_add_child:[cfg articles shop]:><form action="/cgi-bin/admin/add.pl"><input type=hidden name=type value="Catalog">
-  <input type=hidden name=parentid value=3><input type=submit value="Add Catalog"></form><:or:><:eif:>
+  <input type=hidden name=parentid value=3><input type=submit value="Add Catalog"></form>
+<:if Eq [shop generator] "Generate::Catalog":>
+<form action="/cgi-bin/admin/add.pl"><input type="hidden" name="type" value="Product">
+  <input type="hidden" name="parentid" value="3"><input type="submit" value="Add Product"></form><:or Eq:><:eif Eq:>
+<:or:><:eif:>
 <p><font size="-1">BSE Release <:release:></font></p>
 </body>
 </html>
\ No newline at end of file
index 418cbc6..f0ee3c0 100644 (file)
@@ -23,7 +23,7 @@
   </tr>
 </table>
 <:if Article body:> 
-<p><font face="Verdana, Arial, Helvetica, sans-serif" size="2"><:body:></font></p>
+<font face="Verdana, Arial, Helvetica, sans-serif" size="2"><:body:></font>
 <:or Article:><:eif Article:><:if Embedded:><:or Embedded:><:ifAdmin:><:if Children:> 
 <p><font face="Verdana, Arial, Helvetica, sans-serif" size="2">Reorder child articles: 
   <a href="/cgi-bin/admin/reorder.pl?parentid=<:article id:>&sort=title&refreshto=/cgi-bin/admin/admin.pl?id=<:article id:>">by 
diff --git a/site/templates/formmail/defdone_base.tmpl b/site/templates/formmail/defdone_base.tmpl
new file mode 100644 (file)
index 0000000..4d735e4
--- /dev/null
@@ -0,0 +1,19 @@
+<:wrap base.tmpl:>
+<table>
+<:iterator begin fields:>
+<tr>
+  <th><:field description:>:</th>
+  <td>
+  <:switch:>
+  <:case Eq [field htmltype] "textarea":>
+  <:dynreplace [field value] "
+" "<br/>" g :>
+  <:case Eq [field htmltype] "password":>
+  ****************
+  <:case default:>
+  <:field value:>
+  <:endswitch:>
+  </td>
+</tr>
+<:iterator end fields:>
+</table>
diff --git a/site/templates/formmail/defemail.tmpl b/site/templates/formmail/defemail.tmpl
new file mode 100644 (file)
index 0000000..9963d0d
--- /dev/null
@@ -0,0 +1,12 @@
+Your online form has been submitted.
+
+<:if User:>A registered user submitted the form:
+Logon: <:user userId:>
+Email: <:user email:>
+<:or User:>The user wasn't registered/logged on when they submitted the form.
+<:eif User
+:>
+<:iterator begin fields:>
+** <:field description:> **
+  <:field value:>
+<:iterator end fields:>
diff --git a/site/templates/formmail/defquery_base.tmpl b/site/templates/formmail/defquery_base.tmpl
new file mode 100644 (file)
index 0000000..2467229
--- /dev/null
@@ -0,0 +1,27 @@
+<:wrap base.tmpl:>
+<form action="<:script:>" method="post">
+<input type="hidden" name="form" value="<:id:>" />
+<:ifMsg:><p><b><:msg:></b></p><:or:><:eif:>
+<table>
+<:iterator begin fields:>
+<tr>
+  <th><:field description:>:</th>
+  <td>
+  <:switch:>
+  <:case Eq [field htmltype] "textarea":>
+  <textarea name="<:field name:>" <:ifField width:>cols="<:field width:>"<:or:><:eif:> <:ifField height:>rows="<:field height:>"<:or:><:eif:> wrap="virtual"><:old [field name]:></textarea>
+  <:case Eq [field htmltype] "password":>
+  <input type="password" name="<:field name:>" value="<:old [field name]:>" <:ifField width:>size="<:field width:>"<:or:><:eif:> />
+  <:case default:>
+  <input type="text" name="<:field name:>" value="<:old [field name]:>" <:ifField width:>size="<:field width:>"<:or:><:eif:> />
+  <:endswitch:>
+  </td>
+  <td><:error_img [field name]:></td>
+</tr>
+<:iterator end fields:>
+<tr>
+  <td colspan="2"><input type="submit" name="a_send" value="Send" /></td>
+  <td></td>
+</tr>
+</table>
+</form>
\ No newline at end of file
diff --git a/t/t21gencat.t b/t/t21gencat.t
new file mode 100644 (file)
index 0000000..213fbbc
--- /dev/null
@@ -0,0 +1,347 @@
+#!perl -w
+use strict;
+use BSE::Test ();
+use Test::More tests=>69;
+use File::Spec;
+use FindBin;
+my $cgidir = File::Spec->catdir(BSE::Test::base_dir, 'cgi-bin');
+ok(chdir $cgidir, "switch to CGI directory");
+push @INC, 'modules';
+require BSE::Cfg;
+my $cfg = BSE::Cfg->new;
+# create some articles to test with
+require Articles;
+require Products;
+require BSE::Util::SQL;
+BSE::Util::SQL->import(qw/sql_datetime/);
+sub template_test($$$$);
+
+my $parent = add_catalog(title=>'Test catalog', body=>'test catalog',
+                        parentid => 3,
+                        lastModified => '2004-09-23 06:00:00');
+ok($parent, "create parent catalog");
+my @kids;
+for my $name ('One', 'Two', 'Three') {
+  my $kid = add_catalog(title => $name, parentid => $parent->{id}, 
+                       body => "b[$name]");
+  ok($kid, "creating kid catalog $name");
+  push(@kids, $kid);
+}
+
+my $stepkid = add_catalog(title=>'step kid', parentid=>3);
+ok($stepkid, "adding step catalog");
+my $stepprod = add_product(title=>'Delta', parentid=>$stepkid->{id},
+                          retailPrice=>400);
+ok($stepprod, "adding step product");
+
+my %prices = ( Alpha => 100, Beta => 200, Gamma => 300 );
+my @prods;
+for my $name (qw(Alpha Beta Gamma)) {
+  my $prod = add_product(title=>$name, retailPrice => $prices{$name},
+                        parentid => $parent->{id});
+  ok($prod, "creating kid product $name");
+  push @prods, $prod;
+}
+
+require BSE::Admin::StepParents;
+BSE::Admin::StepParents->add($parent, $stepkid);
+BSE::Admin::StepParents->add($parent, $stepprod);
+
+my $top = Articles->getByPkey(1);
+ok($top, "grabbing Home page");
+
+template_test "children_of", $top, <<TEMPLATE, <<EXPECTED;
+<:iterator begin children_of $parent->{id}:><:
+ofchild title:>
+<:iterator end children_of:>
+TEMPLATE
+Gamma
+Beta
+Alpha
+Three
+Two
+One
+
+EXPECTED
+
+template_test "allkids_of", $top, <<TEMPLATE, <<EXPECTED;
+<:iterator begin allkids_of $parent->{id}:><:
+ofallkid title:>
+<:iterator end allkids_of:>
+TEMPLATE
+step kid
+Delta
+Gamma
+Beta
+Alpha
+Three
+Two
+One
+
+EXPECTED
+
+my @kidids = map $_->{id}, @kids;
+template_test "inlines", $top, <<TEMPLATE, <<EXPECTED;
+<:iterator begin inlines @kidids:><:
+inline title:><:iterator end inlines:>
+TEMPLATE
+OneTwoThree
+EXPECTED
+
+template_test "ifancestor positive", $kids[0], <<TEMPLATE, <<EXPECTED;
+<:ifAncestor $parent->{id}:>Yes<:or:>No<:eif:>
+TEMPLATE
+Yes
+EXPECTED
+
+template_test "ifancestor equal", $kids[0], <<TEMPLATE, <<EXPECTED;
+<:ifAncestor $kids[0]{id}:>Yes<:or:>No<:eif:>
+TEMPLATE
+Yes
+EXPECTED
+
+template_test "ifancestor negative", $kids[0], <<TEMPLATE, <<EXPECTED;
+<:ifAncestor $kids[1]{id}:>Yes<:or:>No<:eif:>
+TEMPLATE
+No
+EXPECTED
+
+template_test "children", $parent, <<TEMPLATE, <<EXPECTED;
+<:iterator begin children:><:
+child title:>
+<:iterator end children:>
+TEMPLATE
+Gamma
+Beta
+Alpha
+Three
+Two
+One
+
+EXPECTED
+
+template_test "embed children", $top, <<TEMPLATE, <<EXPECTED;
+<:embed $parent->{id} test/children.tmpl:>
+TEMPLATE
+Gamma
+Beta
+Alpha
+Three
+Two
+One
+
+
+EXPECTED
+
+# test some of the newer basic tags
+template_test "add", $top, <<TEMPLATE, <<EXPECTED;
+<:add 3 4:>
+<:add 3 4 5:>
+<:add 3 [add 4 5]:>
+TEMPLATE
+7
+12
+12
+EXPECTED
+
+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;
+<:match "abc123" "(\d+)":>
+<:match "abc 123" "(\w+)\s+(\w+)" "$2$1":>
+<:match "abc 123" "(\w+)X(\w+)" "$2$1":>
+<:match "abc 123" "(\w+)X(\w+)" "$2$1" "default":>
+TEMPLATE
+123
+123abc
+
+default
+EXPECTED
+
+template_test "replace", $top, <<'TEMPLATE', <<EXPECTED;
+<:replace "abc123" "(\d+)" "XXX" :>
+<:replace "!!abc 123!!" "(\w+)\s+(\w+)" "$2$1":>
+<:replace "abc 123" "(\w+)" "XXX" g:>
+<:replace "abc 123" "X" "$1" :>
+<:replace "abc
+123
+xyz" "\n" "\\n" g:>
+TEMPLATE
+abcXXX
+!!123abc!!
+XXX XXX
+abc 123
+abc\\n123\\nxyz
+EXPECTED
+
+template_test "cases", $top, <<'TEMPLATE', <<EXPECTED;
+<:lc "AbC123 XYZ":>
+<:uc "aBc123 xyz":>
+<:lcfirst "AbC123 XYZ":>
+<:ucfirst "aBc123 xyz":>
+<:capitalize "alpha beta gamma":>
+TEMPLATE
+abc123 xyz
+ABC123 XYZ
+abC123 XYZ
+ABc123 xyz
+Alpha Beta Gamma
+EXPECTED
+
+template_test "arithmetic", $top, <<'TEMPLATE', <<EXPECTED;
+<:arithmetic 2+2:>
+<:arithmetic 2+[add 1 1]:>
+<:arithmetic d2:1.234+1.542:>
+<:arithmetic 2+[add 1 2]+[undefinedtag x]+[add 1 1]+[undefinedtag2]:>
+TEMPLATE
+4
+4
+2.78
+<:arithmetic 2+3+[undefinedtag x]+2+[undefinedtag2]:>
+EXPECTED
+
+template_test "nobodytext", $kids[0], <<'TEMPLATE', <<EXPECTED;
+<:nobodytext article body:>
+TEMPLATE
+One
+EXPECTED
+
+template_test "date", $parent, <<'TEMPLATE', <<EXPECTED;
+<:date "%a %d/%m/%Y" article lastModified:>
+TEMPLATE
+Thu 23/09/2004
+EXPECTED
+
+template_test "strepeats", $parent, <<'TEMPLATE', <<EXPECTED;
+<:iterator begin strepeats [arithmetic 1+1]:><:strepeat index:> <:strepeat value:>
+<:iterator end strepeats:>
+TEMPLATE
+0 1
+1 2
+
+EXPECTED
+
+template_test "strepeats2", $parent, <<'TEMPLATE', <<EXPECTED;
+<:iterator begin strepeats [arithmetic 1+1] 5:><:strepeat index:> <:strepeat value:>
+<:iterator end strepeats:>
+TEMPLATE
+0 2
+1 3
+2 4
+3 5
+
+EXPECTED
+
+BSE::Admin::StepParents->del($parent, $stepkid);
+BSE::Admin::StepParents->del($parent, $stepprod);
+for my $kid (reverse @kids) {
+  my $name = $kid->{title};
+  $kid->remove();
+  ok(1, "removing kid $name");
+}
+$parent->remove();
+ok(1, "removed parent");
+
+my $display_order;
+sub add_article {
+  my (%parms) = @_;
+  $display_order ||= 1000;
+  my %defaults = 
+    (
+     parentid=>-1, displayOrder => 1000, title=>'Test Parent',
+     titleImage => '', body=>'Test parent b[body]',
+     thumbImage => '', thumbWidth => 0, thumbHeight => 0,
+     imagePos => 'tr', release=>sql_datetime(time-86400), expire=>'2999-12-31',
+     keyword=>'', template=>'common/default.tmpl', link=>'', admin=>'',
+     threshold => 5, summaryLength => 100, generator=>'Generate::Article',
+     level => 1, listed=>1, lastModified => sql_datetime(time), flags=>'',
+    );
+  for my $key (%defaults) {
+    unless (exists $parms{$key}) {
+      $parms{$key} = $defaults{$key};
+    }
+  }
+
+  my $sing_type = $parms{_single} || 'Article';
+  my $agg_type = $parms{_aggregate} || 'Articles';
+  $parms{displayOrder} = $display_order;
+  my @artcols = $sing_type->columns;
+  my $article = $agg_type->add(@parms{@artcols[1..$#artcols]});
+  # use consistent links to ensure that the links remain consistent, even 
+  # if they are incorrect
+  $article->{link} = "/a/$display_order.html";
+  $article->{admin} = "/cgi-bin/admin/admin.pl?id=$article->{id}";
+  $article->save;
+  $display_order += 100;
+
+  $article;
+}
+
+sub add_catalog {
+  my (%parms) = @_;
+
+  # this won't put the catalogs in the shop area, but that isn't needed 
+  # for this case.
+  return add_article(template=>'catalog.tmpl', 
+                    generator=>'Generate::Catalog', 
+                    %parms);
+}
+
+sub add_product {
+  my (%parms) = @_;
+
+  # this won't put the catalogs in the shop area, but that isn't needed 
+  # for this case.
+  return add_article(template=>'shopitem.tmpl', 
+                    generator=>'Generate::Product', 
+                    _single => 'Product',
+                    _aggregate => 'Products',
+                    summary => $parms{title} || '',
+                    leadTime=> 0,
+                    gst => int($parms{retailPrice} / 11),
+                    options => '',
+                    subscription_id => -1,
+                    subscription_period => 0,
+                    subscription_usage => 3,
+                    subscription_required => -1,
+                    %parms);
+}
+
+sub template_test($$$$) {
+  my ($tag, $article, $template, $expected) = @_;
+
+  #diag "Template >$template<";
+  my $gen = 
+    eval {
+      (my $filename = $article->{generator}) =~ s!::!/!g;
+      $filename .= ".pm";
+      require $filename;
+      $article->{generator}->new(cfg => $cfg, top => $article);
+    };
+  ok($gen, "$tag: created generator $article->{generator}");
+  diag $@ unless $gen;
+  my $content;
+ SKIP: {
+    skip "$tag: couldn't make generator", 1 unless $gen;
+    eval {
+      $content =
+       $gen->generate_low($template, $article, 'Articles', 0);
+    };
+    ok($content, "$tag: generate content");
+    diag $@ unless $content;
+  }
+ SKIP: {
+     skip "$tag: couldn't gen content", 1 unless $content;
+     is($content, $expected, "$tag: comparing");
+   }
+}
index f5ff5a5..45aaa08 100644 (file)
--- a/test.cfg
+++ b/test.cfg
@@ -92,3 +92,13 @@ affiliate.subscription_required=affiliatepage
 editor.allow_thumb=1
 editor.thumbs_class=BSE::Thumb::Imager
 
+default formmail validation.subject_width=40
+
+test form.fields=name,company
+test form.subject=Foo
+test formmail validation.name_description=Your Name
+test formmail validation.name_required=1
+test formmail validation.name_width=60
+test formmail validation.company_description=Organization
+test formmail validation.company_required=0
+