0.14_10 commit0.14_10 commit0.14_10 commit0.14_10 commit0.14_10 commit0.14_10 commit0... r0_14_10
authorTony Cook <tony@develop-help.com>
Mon, 8 Dec 2003 04:03:40 +0000 (04:03 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Mon, 8 Dec 2003 04:03:40 +0000 (04:03 +0000)
14 files changed:
Makefile
localinst.perl
site/cgi-bin/admin/add.pl
site/cgi-bin/admin/adminusers.pl
site/cgi-bin/modules/BSE/CustomBase.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Template.pm
site/cgi-bin/modules/BSE/UserReg.pm
site/cgi-bin/modules/Generate.pm
site/cgi-bin/modules/Squirrel/Template.pm
site/cgi-bin/modules/Util.pm
site/docs/bse.pod
t/BSE/Test.pm
test.cfg

index 5b15c9e..b27807c 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.14_09
+VERSION=0.14_10
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
index a6278a2..41c0cd3 100644 (file)
@@ -4,6 +4,7 @@ use strict;
 use File::Copy;
 use lib 't';
 use BSE::Test ();
+require ExtUtils::Manifest;
 
 my $dist = shift or die "Usage: $0 distdir [leavedb]";
 my $leavedb = shift or 0;
@@ -26,6 +27,26 @@ system "rm -f $instbase/htdocs/{*.html,a/*.html,shop/*.html,images/*.jpg}"
 system "cp -rf $dist/site/cgi-bin $instbase"
   and die "Cannot copy cgi-bin";
 
+my $perl = BSE::Test::test_perl();
+if ($perl ne '/usr/bin/perl') {
+  my $manifest = ExtUtils::Manifest::maniread();
+
+  for my $file (grep /\.pl$/, keys %$manifest) {
+    (my $work = $file) =~ s!^site!!;
+    next unless $work =~ /cgi-bin/;
+    my $full = $instbase . $work;
+    open SCRIPT, "< $full" or die "Cannot open $full: $!";
+    binmode SCRIPT;
+    my @all = <SCRIPT>;
+    close SCRIPT;
+    $all[0] =~ s/^#!\S*perl\S*/#!$perl/;
+    open SCRIPT, "> $full" or die "Cannot create $full: $!";
+    binmode SCRIPT;
+    print SCRIPT @all;
+    close SCRIPT;
+  }
+}
+
 system "cp -rf $dist/site/htdocs $instbase"
   and die "Cannot copy htdocs";
 system "cp -rf $dist/site/templates $instbase"
index 55dc8ce..94af56b 100755 (executable)
@@ -69,7 +69,7 @@ push @{$result->{headers}}, "Content-Type: $result->{type}";
 push @{$result->{headers}}, $req->extra_headers;
 if (exists $ENV{GATEWAY_INTERFACE}
     && $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl\//) {
-  use Apache;
+  require Apache;
   my $r = Apache->request or die;
   $r->send_cgi_header(join("\n", @{$result->{headers}})."\n");
 }
index befddcd..83bb942 100755 (executable)
@@ -20,7 +20,7 @@ push @{$result->{headers}}, "Content-Type: $result->{type}";
 push @{$result->{headers}}, $req->extra_headers;
 if (exists $ENV{GATEWAY_INTERFACE}
     && $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl\//) {
-  use Apache;
+  require Apache;
   my $r = Apache->request or die;
   $r->send_cgi_header(join("\n", @{$result->{headers}})."\n");
 }
index fe7247c..22f5313 100644 (file)
@@ -50,7 +50,7 @@ sub recalc {
 sub required_fields {
   my ($class, $q, $state, $cfg) = @_;
 
-  qw(name1 name2 address city postcode state country email);
+  qw(name1 name2 address city postcode state country telephone email);
 }
 
 sub purchase_actions {
index 8bef4ba..ba2f9e8 100644 (file)
@@ -481,10 +481,11 @@ sub tag_step_kid {
 
   my $kid = $allkids->[$$rallkid_index]
     or return '';
-  $step_kids->{$kid->{id}}
-    or return;
-  #print STDERR "found kid (want $arg): ", Dumper $kid;
-  escape_html($step_kids->{$kid->{id}}{$arg});
+  my $step_kid = $step_kids->{$kid->{id}}
+    or return '';
+  #use Data::Dumper;
+  #print STDERR "found kid (want $arg): ", Dumper($kid), Dumper($step_kid);
+  escape_html($step_kid->{$arg});
 }
 
 sub tag_move_stepkid {
@@ -2222,7 +2223,8 @@ sub fileadd {
   }
   
   my $basename = '';
-  $file =~ /([\w.-]+)$/ and $basename = $1;
+  $file =~ /([ \w.-]+)$/ and $basename = $1;
+  $basename =~ tr/ /_/;
 
   my $filename = time. '_'. $basename;
 
index 8bd6caf..01c3b46 100644 (file)
@@ -148,7 +148,7 @@ sub output_result {
   push @{$result->{headers}}, $req->extra_headers;
   if (exists $ENV{GATEWAY_INTERFACE}
       && $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl\//) {
-    use Apache;
+    require Apache;
     my $r = Apache->request or die;
     $r->send_cgi_header(join("\n", @{$result->{headers}})."\n");
   }
index 39b0139..faeccc3 100644 (file)
@@ -548,16 +548,18 @@ sub saveopts {
   $user->save;
 
   # subscriptions
+  my $subs;
   if ($cgi->param('saveSubscriptions')) {
-    my $subs = $self->_save_subs($user, $session, $cfg, $cgi);
-    if ($nopassword) {
-      return $self->send_conf_request($session, $cgi, $cfg, $user)
-       if $newemail;
-    }
-    else {
-      return $self->send_conf_request($session, $cgi, $cfg, $user)
-       if $subs && !$user->{confirmed};
-    }
+    $subs = $self->_save_subs($user, $session, $cfg, $cgi);
+  }
+  if ($nopassword) {
+    return $self->send_conf_request($session, $cgi, $cfg, $user)
+      if $newemail;
+  }
+  else {
+    $subs = () = $user->subscriptions unless defined $subs;
+    return $self->send_conf_request($session, $cgi, $cfg, $user)
+      if $subs && !$user->{confirmed};
   }
 
   my $url = $cgi->param('r');
@@ -832,6 +834,9 @@ sub userpage {
       'prodfile', 'prodfiles', \$file_index),
      ifFileAvail =>
      sub {
+       if ($file_index >= 0 && $file_index < @files) {
+        return 1 if !$files[$file_index]{forSale};
+       }
        return 0 if $must_be_paid && !$orders[$order_index]{paidFor};
        return 0 if $must_be_filled && !$orders[$order_index]{filled};
        return 1;
index 8cdd378..642b35d 100644 (file)
@@ -5,6 +5,7 @@ use Constants qw($IMAGEDIR $LOCAL_FORMAT $BODY_EMBED
                  $EMBED_MAX_DEPTH $HAVE_HTML_PARSER);
 use DevHelp::Tags;
 use DevHelp::HTML;
+use BSE::Util::Tags;
 use Util;
 
 my $excerptSize = 300;
@@ -182,8 +183,9 @@ sub _embed_low {
   if ($what !~ /^\d+$/) {
     # not an article id, assume there's an article here we can use
     $id = $acts->{$what} && $acts->{$what}->('id');
-    unless ($id =~ /^\d+$/) {
+    unless ($id && $id =~ /^\d+$/) {
       # save it for later
+      defined $template or $template = "-";
       return "<:embed $what $template $maxdepth:>";
     }
   }
@@ -302,46 +304,35 @@ sub format_body {
 
     #my $incr = @images > 1 ? 2*$len / (2*@images+1) : 0;
     my $incr = $len / @images;
-    if ($imagePos =~ /t/) {
-      # inserting the image tags moves character positions around
-      # so we need the temp buffer
-      my $output = '';
-      for my $image (@images) {
-       # adjust to make sure this isn't in the middle of a tag or entity
-       my $pos = $self->adjust_for_html($body, $incr);
-
-       # assuming 5.005_03 would make this simpler, but <sigh>
-       my $img = qq!<img src="/images/$image->{image}"!
-         .qq! width="$image->{width}" height="$image->{height}" border="0"!
-           .qq! alt="$image->{alt}" align="$align" hspace="10" vspace="10" />!;
-       if ($image->{url}) {
-         $img = qq!<a href="$image->{url}">$img</a>!;
-       }
-       $output .= $img;
-       $output .= substr($body, 0, $pos);
-       substr($body, 0, $pos) = '';
+    # inserting the image tags moves character positions around
+    # so we need the temp buffer
+    if ($imagePos =~ /b/) {
+      @images = reverse @images;
+      if (@images % 2 == 0) {
+       # starting at the bottom, swap it around
        $align = $align eq 'right' ? 'left' : 'right';
       }
-      $body = $output . $body; # don't forget the rest of it
     }
-    else {
-      # work from the end
-      my $pos = $len;
-      for my $image (@images) {
-       my $workpos = $self->adjust_for_html($body, $pos);;
-
-       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" />
-IMG
-       $pos -= $incr;
-       $align = $align eq 'right' ? 'left' : 'right';
+    my $output = '';
+    for my $image (@images) {
+      # adjust to make sure this isn't in the middle of a tag or entity
+      my $pos = $self->adjust_for_html($body, $incr);
+      
+      # assuming 5.005_03 would make this simpler, but <sigh>
+      my $img = qq!<img src="/images/$image->{image}"!
+       .qq! width="$image->{width}" height="$image->{height}" border="0"!
+         .qq! alt="$image->{alt}" align="$align" hspace="10" vspace="10" />!;
+      if ($image->{url}) {
+       $img = qq!<a href="$image->{url}">$img</a>!;
       }
-
+      $output .= $img;
+      $output .= substr($body, 0, $pos);
+      substr($body, 0, $pos) = '';
+      $align = $align eq 'right' ? 'left' : 'right';
     }
-
+    $body = $output . $body; # don't forget the rest of it
   }
-
+  
   return make_entities($body);
 }
 
index 637fabb..8cde25d 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use Carp qw/cluck confess/;
 use constant DEBUG => 0;
 
-$VERSION="0.07";
+$VERSION="0.08";
 
 sub new {
   my ($class, %opts) = @_;
@@ -273,7 +273,7 @@ sub switch {
 
   print STDERR "** switch\n" if DEBUG;
 
-  my @cases = split /(?=<:\s*case\s)/gs, $content;
+  my @cases = split /(?=<:\s*case\s)/s, $content;
   shift @cases if @cases && $cases[0] !~ /<:\s*case\s/;
   my $case;
   while ($case = shift @cases) {
index 6f41e99..da97604 100644 (file)
@@ -160,6 +160,7 @@ sub generate_extras {
   }
   close EXTRAS;
   use Generate;
+  require BSE::Template;
   my $gen = Generate->new(cfg=>$cfg);
   for my $row (@extras) {
     my ($in, $out) = @$row;
index dc19f56..bc61564 100644 (file)
@@ -10,6 +10,62 @@ Maybe I'll add some other bits here.
 
 =head1 CHANGES
 
+=head2 0.14_10
+
+=over
+
+=item *
+
+the stepkid tag would sometimes result in a warning in the web server
+error log
+
+=item *
+
+the templater would produce a warning from a <:switch:> tag under perl
+5.8.
+
+=item *
+
+the installer while now set the #! line of scripts based on the "perl"
+configuration option in test.cfg.
+
+=item *
+
+some scripts would produce compilation errors when run under a perl
+without mod_perl installed.
+
+=item *
+
+the implementation top/bottom left/right image placement has changed.
+When you select a "bottom" option the images are simply placed as if
+they were present in reverse order.  This means that the image urls
+are now used to form links.
+
+=item *
+
+gen.pl could produce a compilation error in some circumstances.
+
+=item *
+
+the telephone field is now actually required on checkout.
+
+=item *
+
+if the user options form included the email address but not the
+subscriptions list and the user changed their email address, the
+confirmation email wasn't being sent.
+
+=item *
+
+the <:ifItemAvail:> tag wasn't returning true for files that don't
+require payment
+
+=item *
+
+spaces are now preserved in uploaded filenames, as underscores.
+
+=back
+
 =head2 0.14_09
 
 =over
index dd15027..9606a89 100644 (file)
@@ -41,6 +41,7 @@ sub test_dbpass { $conf{dbpass} or die "No dbpass in test config" }
 sub test_dbclass { $conf{dbclass} or die "No dbclass in test config" }
 
 sub test_sessionclass { $conf{sessionclass} or die "No sessionclass in config" }
+sub test_perl { $conf{perl} or "/usr/bin/perl" }
 
 sub test_conffile {
   return $conffile;
index 99fafc3..72f3bc9 100644 (file)
--- a/test.cfg
+++ b/test.cfg
@@ -50,7 +50,7 @@ site users.billing_on_main_opts=0
 #paths.libraries=/home/tony/dev/bse/tandb_dealer/cvs/modules
 #paths.siteuser_passwd=/home/httpd/bsetest/data/supasswd
 #custom.user_auth=1
-product fields.retailPrice=Dealer Price Inc GST
+product fields.retailPrice=Dealer Price Inc GST
 $paths.local_templates=/home/tony/dev/bse/tandb_dealer/cvs/templates
 shop.payment_types=1,2,10,11,12
 payment type names.10=DirectDeposit
@@ -70,3 +70,5 @@ tandb custom.siteuser_include_flag=a
 #test.100=gamma
 #test.1000=delta
 
+perl=/opt/perl-5.8.1/bin/perl
+downloads.must_be_filled=1