0.15_25 commit

diff --git a/MANIFEST b/MANIFEST
index 9dc713c48b65cd15673795a4b07129f732ce6027..905a1fc872d93790a41c8a097786b24524391fa3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -436,6 +436,7 @@ site/templates/user/unsuball_base.tmpl
 site/templates/user/unsubone_base.tmpl
 site/templates/user/userpage_base.tmpl
 site/templates/xbase.tmpl
+site/util/bseaddimages.pl
 site/util/gen.pl
 site/util/initial.pl
 site/util/loaddata.pl

diff --git a/Makefile b/Makefile
index 729c03c8baa6617d6d232e8828a2fdebf697df01..ced1cdd7f4a6e99754ad24ac8b427f6d65832f4f 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.15_24
+VERSION=0.15_25
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar

diff --git a/site/cgi-bin/modules/Article.pm b/site/cgi-bin/modules/Article.pm
index 976c72085fb7a49effd5c4635affd23e123c74ce..7f712ddcb527afc4ee0582c9241b940d598d4e6d 100644 (file)
--- a/site/cgi-bin/modules/Article.pm
+++ b/site/cgi-bin/modules/Article.pm
@@ -184,4 +184,19 @@ sub remove_group_id {
   BSE::DB->single->run(articleDeleteSiteUserGroup => $self->{id}, $id);
 }
 
+sub is_access_controlled {
+  my ($self) = @_;
+
+  my @group_ids = $self->group_ids;
+  return 1 if @group_ids;
+
+  return 0
+    unless $self->{inherit_siteuser_rights};
+
+  my $parent = $self->parent
+    or return 0;
+
+  return $parent->is_access_controlled;
+}
+
 1;

diff --git a/site/cgi-bin/modules/BSE/Edit/Article.pm b/site/cgi-bin/modules/BSE/Edit/Article.pm
index 5efaf85497f6d0dd21a48ab4f0865ec33a65b164..468d272c7b5a82a61ebd484ec2fc9621d9fbde93 100644 (file)
--- a/site/cgi-bin/modules/BSE/Edit/Article.pm
+++ b/site/cgi-bin/modules/BSE/Edit/Article.pm
@@ -1333,7 +1333,7 @@ sub make_link {
   my ($self, $article) = @_;
 
   if ($article->is_dynamic) {
-    return "/cgi-bin/page.pl?id=$article->{id}&title=".escape_uri($article->{title});
+    return "/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($article->{title});
   }
 
   my $article_uri = $self->link_path($article);

diff --git a/site/cgi-bin/modules/BSE/Edit/Catalog.pm b/site/cgi-bin/modules/BSE/Edit/Catalog.pm
index d48923ce2642da8e5e0683e41404b92c56b9790c..86219167c585f8c2103f1545d4e671c61d556b68 100644 (file)
--- a/site/cgi-bin/modules/BSE/Edit/Catalog.pm
+++ b/site/cgi-bin/modules/BSE/Edit/Catalog.pm
@@ -96,7 +96,7 @@ sub make_link {
 # end adrian
 
   if ($article->is_dynamic) {
-    return "$urlbase/cgi-bin/page.pl?id=$article->{id}&title=".escape_uri($article->{title});
+    return "$urlbase/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($article->{title});
   }
 
   my $shop_uri = $self->link_path($article);

diff --git a/site/cgi-bin/modules/BSE/Edit/Product.pm b/site/cgi-bin/modules/BSE/Edit/Product.pm
index 84b2dd99f67ccac5efea85a9de73209b2dc77b16..befe997baeaccde118c65c56df2a4b2fd15b9ece 100644 (file)
--- a/site/cgi-bin/modules/BSE/Edit/Product.pm
+++ b/site/cgi-bin/modules/BSE/Edit/Product.pm
@@ -241,7 +241,7 @@ sub make_link {
 # end adrian
 
   if ($article->is_dynamic) {
-    return "$urlbase/cgi-bin/page.pl?id=$article->{id}&title=".escape_uri($article->{title});
+    return "$urlbase/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($article->{title});
   }
 
   my $shop_uri = $self->link_path($article);

diff --git a/site/cgi-bin/modules/BSE/UI/Page.pm b/site/cgi-bin/modules/BSE/UI/Page.pm
index 1c3694d868960c1d4ea204c9c6417c824db7a241..9086e6779e5666c2c2ba2034426acc1579d77664 100644 (file)
--- a/site/cgi-bin/modules/BSE/UI/Page.pm
+++ b/site/cgi-bin/modules/BSE/UI/Page.pm
@@ -9,9 +9,9 @@ sub dispatch {
   my ($class, $req) = @_;
 
   my $cgi = $req->cgi;
-  my $id = $cgi->param('id');
+  my $id = $cgi->param('page');
   $id && $id =~ /^\d+$/
-    or return $class->error($req, "required id parameter not present or invalid");
+    or return $class->error($req, "required page parameter not present or invalid");
   my $article = Articles->getByPkey($id)
     or return $class->error($req, "unknown article id $id");
 

diff --git a/site/cgi-bin/modules/BSE/UserReg.pm b/site/cgi-bin/modules/BSE/UserReg.pm
index a1aa52c54cd48b4e4b0ccecff2604dbaec39ade0..61ea4d4a029ac3a4d1035da3175722bd60e7a27a 100644 (file)
--- a/site/cgi-bin/modules/BSE/UserReg.pm
+++ b/site/cgi-bin/modules/BSE/UserReg.pm
@@ -74,18 +74,18 @@ sub logon {
   }
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
   my $userid = $cgi->param('userid')
-    or return $self->show_logon($session, $cgi, $cfg, 
+    or return $self->show_logon($req, 
                                $msgs->(needlogon=>"Please enter a logon name"));
   my $password = $cgi->param('password')
-    or return $self->show_logon($session, $cgi, $cfg, 
+    or return $self->show_logon($req,
                                $msgs->(needpass=>"Please enter your password"));
   my $user = SiteUsers->getBy(userId => $userid);
   unless ($user && $user->{password} eq $password) {
-    return $self->show_logon($session, $cgi, $cfg, 
+    return $self->show_logon($req,
                             $msgs->(baduserpass=>"Invalid user or password"));
   }
   if ($user->{disabled}) {
-    return $self->show_logon($session, $cgi, $cfg,
+    return $self->show_logon($req,
                             $msgs->(disableduser=>"Account $userid has been disabled"));
   }
   $session->{userid} = $user->{userId};
@@ -166,7 +166,7 @@ sub set_cookie {
   my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
   my $cookie = $cgi->param('setcookie')
-    or return $self->show_logon($session, $cgi, $cfg, 
+    or return $self->show_logon($req, 
                                $msgs->(nocookie=>"No cookie provided"));
   print STDERR "Setting sessionid to $cookie for $ENV{HTTP_HOST}\n";
   my %newsession;
@@ -176,7 +176,7 @@ sub set_cookie {
     $newsession{custom} = $session->{custom} if exists $session->{custom};
   }
   my $refresh = $cgi->param('r') 
-    or return $self->show_logon($session, $cgi, $cfg, 
+    or return $self->show_logon($req, 
                                $msgs->(norefresh=>"No refresh provided"));
   my $userid = $newsession{userid};
   if ($userid) {
@@ -207,7 +207,7 @@ sub logoff {
 
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
   my $userid = $session->{userid}
-    or return $self->show_logon($session, $cgi, $cfg, 
+    or return $self->show_logon($req, 
                                $msgs->(notloggedon=>"You aren't logged on"));
 
   delete $session->{userid};
@@ -251,11 +251,11 @@ sub show_register {
   my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
   unless ($user_register) {
     if ($nopassword) {
-      return $self->show_lost_password($session, $cgi, $cfg,
+      return $self->show_lost_password($req,
                                       "Registration disabled");
     }
     else {
-      return $self->show_logon($session, $cgi, $cfg,
+      return $self->show_logon($req,
                               "Registration disabled");
     }
   }
@@ -545,7 +545,7 @@ sub saveopts {
   $self->_save_images($cfg, $cgi, $user, \%errors);
 
   keys %errors
-    and return $self->show_opts($session, $cgi, $cfg, undef, \%errors);
+    and return $self->show_opts($req, undef, \%errors);
   my $newemail;
   if ($saveemail && $email ne $user->{email}) {
     $user->{confirmed} = 0;
@@ -648,10 +648,10 @@ sub register {
   unless ($user_register) {
     my $msg = $msgs->(regdisabled => "Registration disabled");
     if ($nopassword) {
-      return $self->show_lost_password($session, $cgi, $cfg, $msg);
+      return $self->show_lost_password($req, $msg);
     }
     else {
-      return $self->show_logon($session, $cgi, $cfg, $msg);
+      return $self->show_logon($req, $msg);
     }
   }
 
@@ -761,7 +761,7 @@ sub register {
   defined $aff_name or $aff_name = '';
 
   if (keys %errors) {
-    return $self->show_register($session, $cgi, $cfg, undef, \%errors);
+    return $self->show_register($req, undef, \%errors);
   }
 
   $user{email} = $email;
@@ -797,9 +797,7 @@ sub register {
     $custom->siteusers_changed($cfg);
   }
   else {
-    $self->show_register($session, $cgi, $cfg,
-                        $msgs->(regdberr=>
-                                "Database error $@"));
+    $self->show_register($req, $msgs->(regdberr=> "Database error $@"));
   }
 }
 
@@ -943,7 +941,7 @@ sub req_orderdetail {
   $order->{userId} eq $user->{userId} || $order->{siteuser_id} == $user->{id}
     or undef $order;
   $order
-    or return $self->userpage($session, $cgi, $cfg, "No such order");
+    or return $self->userpage($req, "No such order");
   $message ||= $cgi->param('message') || '';
 
   my $must_be_paid = $cfg->entryBool('downloads', 'must_be_paid', 0);
@@ -1072,29 +1070,29 @@ sub download_file {
     $user = SiteUsers->getBy(userId=>$userid);
   }
   my $fileid = $cgi->param('file')
-    or return $self->show_logon($session, $cgi, $cfg, 
+    or return $self->show_logon($req, 
                         $msgs->('nofileid', "No file id supplied"));
   require 'ArticleFiles.pm';
   my $file = ArticleFiles->getByPkey($fileid)
-    or return $self->show_logon($session, $cgi, $cfg,
+    or return $self->show_logon($req,
                         $msgs->('nosuchfile', "No such download"));
   $cfg->entryBool('downloads', 'require_logon', 0) && !$user
-    and return $self->show_logon($session, $cgi, $cfg,
+    and return $self->show_logon($req,
                          $msgs->('downloadlogonall', 
                                  "You must be logged on to download files"));
     
   $file->{requireUser} && !$user
-    and return $self->show_logon($session, $cgi, $cfg,
+    and return $self->show_logon($req,
                          $msgs->('downloadlogon',
                                  "You must be logged on to download this file"));
   $file->{forSale}
-    and return $self->show_logon($session, $cgi, $cfg,
+    and return $self->show_logon($req,
                          $msgs->('downloadforsale',
                                  "This file can only be downloaded as part of an order"));
   
   my $filebase = $cfg->entryVar('paths', 'downloads');
   open FILE, "< $filebase/$file->{filename}"
-    or return $self->show_logon($session, $cgi, $cfg, 
+    or return $self->show_logon($req, 
               $msgs->(openfile =>
                       "Sorry, cannot open that file.  Contact the webmaster.",
                       $!));
@@ -1151,12 +1149,12 @@ sub lost_password {
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
   my $userid = $cgi->param('userid');
   defined $userid && length $userid
-    or return $self->show_lost_password($session, $cgi, $cfg,
+    or return $self->show_lost_password($req,
                                        $msgs->(lostnouserid=>
                                                "Please enter a logon id"));
   
   my $user = SiteUsers->getBy(userId=>$userid)
-    or return $self->show_lost_password($session, $cgi, $cfg,
+    or return $self->show_lost_password($req,
                                        $msgs->(lostnosuch=>
                                                "No such userid", $userid));
 
@@ -1179,7 +1177,7 @@ sub lost_password {
     || ($nopassword ? "Your options" : "Your password");
   $mail->send(from=>$from, to=>$user->{email}, subject=>$subject,
              body=>$body)
-    or return $self->show_lost_password($session, $cgi, $cfg,
+    or return $self->show_lost_password($req,
                                        $msgs->(lostmailerror=>
                                                "Email error:".$mail->errstr,
                                                $mail->errstr));
@@ -1200,9 +1198,9 @@ sub subinfo {
   my $session = $req->session;
 
   my $id = $cgi->param('id')
-    or return $self->show_opts($session, $cgi, $cfg, "No subscription id parameter");
+    or return $self->show_opts($req, "No subscription id parameter");
   my $sub = BSE::SubscriptionTypes->getByPkey($id)
-    or return $self->show_opts($session, $cgi, $cfg, "Unknown subscription id");
+    or return $self->show_opts($req, "Unknown subscription id");
   my %acts;
   %acts =
     (
@@ -1236,7 +1234,7 @@ sub blacklist {
 
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
   my $email = $cgi->param('blacklist')
-    or return $self->show_logon($session, $cgi, $cfg,
+    or return $self->show_logon($req,
                                $msgs->(blnoemail=>"No email supplied"));
   my $genemail = _generic_email($email);
 
@@ -1270,20 +1268,20 @@ sub confirm {
 
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
   my $secret = $cgi->param('confirm')
-    or return $self->show_logon($session, $cgi, $cfg,
+    or return $self->show_logon($req,
                                $msgs->(confnosecret=>"No secret supplied for confirmation"));
   my $userid = $cgi->param('u')
-    or return $self->show_logon($session, $cgi, $cfg,
+    or return $self->show_logon($req,
                                $msgs->(confnouser=>"No user supplied for confirmation"));
   if ($userid + 0 != $userid || $userid < 1) {
-    return $self->show_logon($session, $cgi, $cfg,
+    return $self->show_logon($req,
                             $msgs->(confbaduser=>"Invalid or unknown user supplied for confirmation"));
   }
   my $user = SiteUsers->getByPkey($userid)
-    or return $self->show_logon($session, $cgi, $cfg,
+    or return $self->show_logon($req,
                             $msgs->(confbaduser=>"Invalid or unknown user supplied for confirmation"));
   unless ($secret eq $user->{confirmSecret}) {
-    return $self->show_logon($session, $cgi, $cfg, 
+    return $self->show_logon($req, 
                             $msgs->(confbadsecret=>"Sorry, the confirmation secret does not match"));
   }
 
@@ -1437,20 +1435,20 @@ sub unsub {
 
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
   my $secret = $cgi->param('unsub')
-    or return $self->show_logon($session, $cgi, $cfg,
+    or return $self->show_logon($req,
                                $msgs->(unsubnosecret=>"No secret supplied for unsubscribe"));
   my $userid = $cgi->param('u')
-    or return $self->show_logon($session, $cgi, $cfg,
+    or return $self->show_logon($req,
                                $msgs->(unsubnouser=>"No user supplied for unsubscribe"));
   if ($userid + 0 != $userid || $userid < 1) {
-    return $self->show_logon($session, $cgi, $cfg,
+    return $self->show_logon($req,
                             $msgs->(unsubbaduser=>"Invalid or unknown user supplied for unsubscribe"));
   }
   my $user = SiteUsers->getByPkey($userid)
-    or return $self->show_logon($session, $cgi, $cfg,
+    or return $self->show_logon($req,
                             $msgs->(unsubbaduser=>"Invalid or unknown user supplied for unsubscribe"));
   unless ($secret eq $user->{confirmSecret}) {
-    return $self->show_logon($session, $cgi, $cfg, 
+    return $self->show_logon($req, 
                             $msgs->(unsubbadsecret=>"Sorry, the ubsubscribe secret does not match"));
   }
   
@@ -1532,20 +1530,16 @@ sub req_image {
   my $u = $cgi->param('u');
   my $i = $cgi->param('i');
   defined $u && $u =~ /^\d+$/ && defined $i && $i =~ /^\w+$/
-    or return $self->show_logon($session, $cgi, $cfg, 
-                               "Missing or bad image parameter");
+    or return $self->show_logon($req, "Missing or bad image parameter");
 
   my $user = SiteUsers->getByPkey($u)
-    or return $self->show_logon($session, $cgi, $cfg, 
-                               "Missing or bad image parameter");
+    or return $self->show_logon($req, "Missing or bad image parameter");
   my $image = $user->get_image($i)
-    or return $self->show_logon($session, $cgi, $cfg, 
-                               "Unknown image id");
+    or return $self->show_logon($req, "Unknown image id");
   my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
 
   open IMAGE, "< $image_dir/$image->{filename}"
-    or return $self->show_logon($session, $cgi, $cfg,
-                               "Image file missing");
+    or return $self->show_logon($req, "Image file missing");
   binmode IMAGE;
   binmode STDOUT;
     

diff --git a/site/cgi-bin/modules/Generate.pm b/site/cgi-bin/modules/Generate.pm
index 87d7c3c35bc14678d701c7974b57895ff76d3217..d69c51fde79a25409df004c971c68c3659e897a3 100644 (file)
--- a/site/cgi-bin/modules/Generate.pm
+++ b/site/cgi-bin/modules/Generate.pm
@@ -7,6 +7,7 @@ use DevHelp::Tags;
 use DevHelp::HTML;
 use BSE::Util::Tags;
 use BSE::CfgInfo qw(custom_class);
+use BSE::Util::Iterate;
 
 my $excerptSize = 300;
 
@@ -425,6 +426,7 @@ sub baseActs {
     my $data = $cfg->entryVar('extra tags', $key);
     $extras{$key} = sub { $data };
   }
+  my $it = BSE::Util::Iterate->new;
   return 
     (
      %extras,
@@ -525,12 +527,9 @@ sub baseActs {
          return escape_html($text);
        }
      },
-     DevHelp::Tags->make_iterator2
-     ( \&iter_kids_of, 'ofchild', 'children_of' ), 
-     DevHelp::Tags->make_iterator2
-     ( \&iter_all_kids_of, 'ofallkid', 'allkids_of' ), 
-     DevHelp::Tags->make_iterator2
-     ( \&iter_inlines, 'inline', 'inlines' ),
+     $it->make_iterator( \&iter_kids_of, 'ofchild', 'children_of' ), 
+     $it->make_iterator( \&iter_all_kids_of, 'ofallkid', 'allkids_of' ), 
+     $it->make_iterator( \&iter_inlines, 'inline', 'inlines' ),
      gimage => 
      sub {
        my ($name, $align, $rest) = split ' ', $_[0], 3;

diff --git a/site/cgi-bin/modules/Generate/Article.pm b/site/cgi-bin/modules/Generate/Article.pm
index cc8f7d414b346aff6a69c2680e3d728bdfdcbde4..cc6929e549f8950772a3903c0391b799d2cbac0c 100644 (file)
--- a/site/cgi-bin/modules/Generate/Article.pm
+++ b/site/cgi-bin/modules/Generate/Article.pm
@@ -516,6 +516,7 @@ HTML
      BSE::Util::Tags->make_iterator(\@stepparents, 'stepparent', 'stepparents'),
      top => [ \&tag_top, $self, $article ],
      ifDynamic => [ \&tag_ifDynamic, $self, $top ],
+     ifAccessControlled => [ \&tag_ifAccessControlled, $article ],
     );
 
   if ($abs_urls) {
@@ -544,6 +545,28 @@ sub tag_ifDynamic {
   UNIVERSAL::isa($top, 'Article') ? $top->is_dynamic : 0;
 }
 
+sub tag_ifAccessControlled {
+  my ($article, $arg, $acts, $templater) = @_;
+
+  if ($arg) {
+    if ($acts->{$arg}) {
+      my $id = $templater->perform($acts, $arg, 'id');
+      $article = Articles->getByPkey($id);
+      unless ($article) {
+       print STDERR "** Unknown article $id from $arg in ifAccessControlled\n";
+       return 0;
+      }
+    }
+    else {
+      print STDERR "** Unknown article $arg in ifAccessControlled\n";
+      return 0;
+    }
+  }
+
+  return UNIVERSAL::isa($article, 'Article') ? 
+    $article->is_access_controlled : 0;
+}
+
 sub generate {
   my ($self, $article, $articles) = @_;
 

diff --git a/site/cgi-bin/modules/Squirrel/Template.pm b/site/cgi-bin/modules/Squirrel/Template.pm
index 7c76bda1118810eac874b136658d814c4d39acfd..955bc32289e20dc221e721a80d3ba8bab1a42405 100644 (file)
--- a/site/cgi-bin/modules/Squirrel/Template.pm
+++ b/site/cgi-bin/modules/Squirrel/Template.pm
@@ -108,7 +108,7 @@ sub perform {
     my $msg = $@;
     $msg =~ /^ENOIMPL\b/
       and return $orig;
-    print STDERR "Eval error in cond: $msg\n";
+    print STDERR "Eval error in perform: $msg\n";
     $msg =~ s/([<>&])/"&#".ord($1).";"/ge;
     return "<!-- ** $msg ** -->";
   }
@@ -216,7 +216,7 @@ sub with {
 }
 
 sub cond {
-  my ($self, $name, $args, $true, $false, $acts, $orig) = @_;
+  my ($self, $name, $args, $acts, $start, $true, $else, $false, $endif) = @_;
 
   print STDERR "cond $name $args\n" if DEBUG;
 
@@ -234,13 +234,18 @@ sub cond {
       }
       else {
        print STDERR " not found\n" if DEBUG > 1;
-       return $orig;
+       $true = $self->replace_template($true, $acts) if length $true;
+       $false = $self->replace_template($false, $acts) if length $false;
+       return "$start$true$else$false$endif";
       }
     };
   if ($@) {
     my $msg = $@;
-    $msg =~ /^ENOIMPL\b/
-      and return $orig;
+    if ($msg =~ /^ENOIMPL\b/) {
+      $true = $self->replace_template($true, $acts) if length $true;
+      $false = $self->replace_template($false, $acts) if length $false;
+      return "$start$true$else$false$endif";
+    }
     print STDERR "Eval error in cond: $msg\n";
     $msg =~ s/([<>&])/"&#".ord($1).";"/ge;
     return "<!-- ** $msg ** -->";
@@ -460,19 +465,19 @@ sub replace_template {
 
   # conditionals
   my $nesting = 0; # prevents loops if result is an if statement
-  1 while $template =~ s/(<:\s*if\s+(\w+)(?:\s+(.*?))?\s*:>
+  1 while $template =~ s/(<:\s*if\s+(\w+)(?:\s+(.*?))?\s*:>)
                           (.*?)
-                         <:\s*or\s+\2\s*:>
+                         (<:\s*or\s+\2\s*:>)
                           (.*?)
-                         <:\s*eif\s+\2\s*:>)/
-                        $self->cond($2, $3, $4, $5, $acts, $1) /sgex
+                         (<:\s*eif\s+\2\s*:>)/
+                        $self->cond($2, $3, $acts, $1, $4, $5, $6, $7) /sgex
                          && ++$nesting < 5;
-  $template =~ s/(<:\s*if([A-Z]\w*)(?:\s+(.*?))?\s*:>
+  $template =~ s/(<:\s*if([A-Z]\w*)(?:\s+(.*?))?\s*:>)
                   (.*?)
-                 <:\s*or\s*:>
+                 (<:\s*or\s*:>)
                   (.*?)
-                 <:\s*eif\s*:>)/
-                $self->cond($2, $3, $4, $5, $acts, $1) /sgex;
+                 (<:\s*eif\s*:>)/
+                $self->cond($2, $3, $acts, $1, $4, $5, $6, $7) /sgex;
 
   $nesting = 0;
   1 while $template =~ s/<:\s*switch\s*:>

diff --git a/site/docs/bse.pod b/site/docs/bse.pod
index 253bfb23e6ff2a60e947a216b7e3c41168383bde..8b47a80eff6ea14d0be28c0c2c108cdb803524a5 100644 (file)
--- a/site/docs/bse.pod
+++ b/site/docs/bse.pod
@@ -10,6 +10,23 @@ Maybe I'll add some other bits here.
 
 =head1 CHANGES
 
+=head2 0.15_25
+
+=over
+
+=item *
+
+if a conditional tag isn't defined when during tag replacement,
+previously defined tags in the true and false parts of the tag were
+not replaced.  They are now.
+
+=item *
+
+page.pl now accepts the article id via the page parameter instead of
+id.
+
+=back
+
 =head2 0.15_24
 
 =over

diff --git a/site/docs/templates.pod b/site/docs/templates.pod
index cdc7c9852de60f988690b2458e29b7c2b245801f..48681fd9451f927abd8569afbbf216fa91b1b757 100644 (file)
--- a/site/docs/templates.pod
+++ b/site/docs/templates.pod
@@ -1153,6 +1153,12 @@ Conditional tag, true if the article has any unnamed images.
 
 Tests if the article is dynamically generated.
 
+=item ifAccessControlled
+
+=item ifAccessControlled I<which>
+
+Tests if the article is access controlled.
+
 =item top I<field>
 
 Toplevel article being generated.  This is the page that any articles

diff --git a/site/util/bseaddimages.pl b/site/util/bseaddimages.pl
new file mode 100644 (file)
index 0000000..a8183a5
--- /dev/null
+++ b/site/util/bseaddimages.pl
@@ -0,0 +1,98 @@
+#!perl -w
+# Bulk add image tool
+
+use strict;
+use LWP::UserAgent;
+use HTTP::Cookies;
+use Getopt::Long;
+use HTTP::Request::Common;
+
+my $verbose;
+my $user;
+my $password;
+Getopt::Long::Configure('bundling');
+GetOptions("v:i", \$verbose,
+          "u", \$user,
+          "p", \$password);
+++$verbose if defined $verbose && !$verbose;
+
+# should be 3 options - base url, article number, input file
+# default to stdin if no input
+my $base_url = shift;
+my $article_id = shift;
+
+defined $article_id
+  or usage();
+$article_id =~ /^(\d+|-1)$/ # -1 for global images
+  or die "Invalid article id\n";
+
+@ARGV or @ARGV = "-";
+
+if ($user && !$password
+    || $password && !$user) {
+  die "-u and -p must both be supplied if either is\n";
+}
+
+my $ua = LWP::UserAgent->new;
+$ua->cookie_jar(HTTP::Cookies->new);
+
+if ($user) {
+  print STDERR "Logging on\n" if $verbose;
+  # go logon
+  my $result = $ua->post("$base_url/cgi-bin/admin/logon.pl",
+                        [ 
+                         logon => $user,
+                         password => $password,
+                         a_logon => 1
+                        ]);
+  # we should see a refresh header on success
+  unless ($result->header("Refresh")) {
+    die "Could not logon\n";
+  }
+}
+
+# check we have a valid article
+my $result = $ua->get("$base_url/cgi-bin/admin/admin.pl?id=$article_id");
+# if the article doesn't exist, we're sent to the menu
+if ($result->header("Refresh")) {
+  die "Article $article_id doesn't exist\n";
+}
+
+# ok, start working on them
+while (<>) {
+  chomp;
+  my ($filename, $alt) = split;
+
+  open IMG, "<$filename" or die "Cannot open $filename: $!\n";
+  binmode IMG;
+  my $imdata = do { local $/; <IMG> };
+  close IMG;
+
+  print STDERR "Adding $filename / $alt\n" if $verbose;
+  # make a request
+  my $req = POST "$base_url/cgi-bin/admin/add.pl",
+     [
+      id => $article_id,
+      image => [ undef, $filename, Content => $imdata ],
+      altIn => $alt,
+      url => '',
+      name=> '',
+      addimg => 1,
+      level => 1,
+     ],
+     Content_Type => 'form-data';
+  #print "Req", $req->as_string,"\n";
+  my $result = $ua->request($req);
+
+  # should refresh on success
+  unless ($result->header("refresh")) {
+    print $result->content;
+    die "Could not add image\n";
+  }
+}
+
+sub usage {
+  die <<EOS
+Usage: $0 [-u user] [-p password] [-v verbosity] baseurl article id sources
+EOS
+}

diff --git a/t/t00smoke.t b/t/t00smoke.t
index 708b357622fb5c9b92935c3d87606bf65aabb4b8..883c5c197be294757c09621a4823304e936e6a47 100644 (file)
--- a/t/t00smoke.t
+++ b/t/t00smoke.t
@@ -70,5 +70,5 @@ fetch_ok($ua, "reorder", "$baseurl/cgi-bin/admin/reorder.pl",
 
 fetch_ok($ua, 'fmail', "$baseurl/cgi-bin/fmail.pl",
         qr!name="form"!);
-fetch_ok($ua, 'page.pl?id=1', "$baseurl/cgi-bin/page.pl?id=1",
+fetch_ok($ua, 'page.pl?page=1', "$baseurl/cgi-bin/page.pl?id=1",
         qr!welcome\s+to\stest\s+server!i);

diff --git a/t/t010template.t b/t/t010template.t
index 0b54d76a39933570ce44901e9b02864fe3bbd161..f070a058587c6c5adfe4c5bf81fcef99211d97a4 100644 (file)
--- a/t/t010template.t
+++ b/t/t010template.t
@@ -1,7 +1,7 @@
 #!perl -w
 # Basic tests for Squirrel::Template
 use strict;
-use Test::More tests => 18;
+use Test::More tests => 20;
 
 sub template_test($$$$;$);
 
@@ -74,6 +74,20 @@ OUT
   template_test("<:include doesnt/exist optional:>", "", "optional include", \%acts);
   template_test("<:include doesnt/exist:>", "** cannot find include doesnt/exist in path **", "failed include", \%acts);
   template_test("x<:include included.include:>z", "xyz", "include", \%acts);
+
+  template_test <<IN, <<OUT, "nested in undefined if", \%acts;
+<:if Unknown:><:if Eq "1" "1":>Equal<:or Eq:>Not Equal<:eif Eq:><:or Unknown:>false unknown<:eif Unknown:>
+IN
+<:if Unknown:>Equal<:or Unknown:>false unknown<:eif Unknown:>
+OUT
+  template_test <<IN, <<OUT, "nested in undefined switch case", \%acts;
+<:switch:>
+<:case ifUnknown:><:if Eq 1 1:>Equal<:or Eq:>Unequal<:eif Eq:>
+<:endswitch:>
+IN
+<:switch:><:case ifUnknown:>Equal
+<:endswitch:>
+OUT
 }
 
 sub template_test ($$$$;$) {