most of UTF-8 support
authorTony Cook <tony@develop-help.com>
Mon, 25 Oct 2010 04:46:45 +0000 (04:46 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Mon, 25 Oct 2010 04:46:45 +0000 (04:46 +0000)
66 files changed:
MANIFEST
schema/bse.sql
site/cgi-bin/admin/admin.pl
site/cgi-bin/bse.cfg
site/cgi-bin/modules/BSE/AdminLogon.pm
site/cgi-bin/modules/BSE/AdminSiteUsers.pm
site/cgi-bin/modules/BSE/AdminUsers.pm
site/cgi-bin/modules/BSE/Arrows.pm
site/cgi-bin/modules/BSE/CGI.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/ChangePW.pm
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Dynamic/Article.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Edit/Catalog.pm
site/cgi-bin/modules/BSE/Edit/Product.pm
site/cgi-bin/modules/BSE/Edit/Seminar.pm
site/cgi-bin/modules/BSE/FileHandler/Default.pm
site/cgi-bin/modules/BSE/FileHandler/FLV.pm
site/cgi-bin/modules/BSE/Formatter.pm
site/cgi-bin/modules/BSE/Formatter/Article.pm
site/cgi-bin/modules/BSE/Generate/Seminar.pm
site/cgi-bin/modules/BSE/ImageHandler/Flash.pm
site/cgi-bin/modules/BSE/ImageHandler/Img.pm
site/cgi-bin/modules/BSE/Message.pm
site/cgi-bin/modules/BSE/Request/Base.pm
site/cgi-bin/modules/BSE/Shop/Util.pm
site/cgi-bin/modules/BSE/TB/ArticleFile.pm
site/cgi-bin/modules/BSE/TB/Image.pm
site/cgi-bin/modules/BSE/TagFormats.pm
site/cgi-bin/modules/BSE/Template.pm
site/cgi-bin/modules/BSE/ThumbLow.pm
site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm
site/cgi-bin/modules/BSE/UI/AdminReport.pm
site/cgi-bin/modules/BSE/UI/AdminSeminar.pm
site/cgi-bin/modules/BSE/UI/AdminShop.pm
site/cgi-bin/modules/BSE/UI/Affiliate.pm
site/cgi-bin/modules/BSE/UI/Background.pm
site/cgi-bin/modules/BSE/UI/Formmail.pm
site/cgi-bin/modules/BSE/UI/Image.pm
site/cgi-bin/modules/BSE/UI/Page.pm
site/cgi-bin/modules/BSE/UI/Redirect.pm
site/cgi-bin/modules/BSE/UI/Search.pm
site/cgi-bin/modules/BSE/UI/Shop.pm
site/cgi-bin/modules/BSE/UI/SiteUserUpdate.pm
site/cgi-bin/modules/BSE/UI/SiteuserCommon.pm
site/cgi-bin/modules/BSE/UI/SubAdmin.pm
site/cgi-bin/modules/BSE/UI/User.pm
site/cgi-bin/modules/BSE/UserReg.pm
site/cgi-bin/modules/BSE/Util/DynamicTags.pm
site/cgi-bin/modules/BSE/Util/HTML.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Util/Iterate.pm
site/cgi-bin/modules/BSE/Util/Tags.pm
site/cgi-bin/modules/DevHelp/HTML.pm
site/cgi-bin/modules/Generate.pm
site/cgi-bin/modules/Generate/Article.pm
site/cgi-bin/modules/Generate/Product.pm
site/cgi-bin/modules/Generate/Subscription.pm
site/cgi-bin/modules/Squirrel/Template.pm
site/cgi-bin/modules/Util.pm
site/data/db/bse_msg_base.data
site/docs/bse-unicode.pod [new file with mode: 0644]
site/docs/standard.pod
site/htdocs/js/bse_api.js
site/templates/admin/xbase.tmpl
site/templates/search_base.tmpl
site/util/mysql.str

index 2afb764..1938cc4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -72,6 +72,7 @@ site/cgi-bin/modules/BSE/CustomBase.pm
 site/cgi-bin/modules/BSE/DB.pm
 site/cgi-bin/modules/BSE/DB/MSSQL.pm
 site/cgi-bin/modules/BSE/DB/Mysql.pm
+site/cgi-bin/modules/BSE/CGI.pm
 site/cgi-bin/modules/BSE/Countries.pm
 site/cgi-bin/modules/BSE/Dynamic/Article.pm
 site/cgi-bin/modules/BSE/Dynamic/Catalog.pm
@@ -239,6 +240,7 @@ site/cgi-bin/modules/BSE/UserReg.pm
 site/cgi-bin/modules/BSE/Util/ContentType.pm
 site/cgi-bin/modules/BSE/Util/DynSort.pm
 site/cgi-bin/modules/BSE/Util/DynamicTags.pm
+site/cgi-bin/modules/BSE/Util/HTML.pm
 site/cgi-bin/modules/BSE/Util/Iterate.pm
 site/cgi-bin/modules/BSE/Util/SQL.pm
 site/cgi-bin/modules/BSE/Util/Secure.pm
@@ -259,6 +261,7 @@ site/cgi-bin/modules/Courier/AustraliaPost/Sea.pm
 site/cgi-bin/modules/Courier/Fastway/Road.pm
 site/cgi-bin/modules/Courier/Fastway/Satchel.pm
 site/cgi-bin/modules/Courier/Null.pm
+site/cgi-bin/modules/DevHelp/Cfg.pm
 site/cgi-bin/modules/DevHelp/Date.pm
 site/cgi-bin/modules/DevHelp/DynSort.pm
 site/cgi-bin/modules/DevHelp/FileUpload.pm
index 53b5360..fa3e11c 100644 (file)
@@ -154,7 +154,7 @@ CREATE TABLE image (
 DROP TABLE IF EXISTS sessions;
 CREATE TABLE sessions (
   id char(32) not null primary key,
-  a_session text,
+  a_session blob,
   -- so we can age this table
   whenChanged timestamp
   -- note: an index on whenChanged would speed up only the rare case 
@@ -174,7 +174,7 @@ create table product (
 
   -- prices are in cents
   retailPrice integer not null,
-  wholesalePrice integer,
+  wholesalePrice integer not null,
 
   -- amount of GST on this item
   gst integer not null,
index c583cb7..00e7856 100755 (executable)
@@ -64,7 +64,12 @@ if ($req->check_admin_logon()) {
     else {
       my $type = BSE::Template->html_type($req->cfg);
       print "Content-Type: $type\n\n";
-      print $generator->generate($article, $articles);
+      my $page = $generator->generate($article, $articles);
+      if ($req->utf8) {
+       require Encode;
+       $page = Encode::encode($req->charset, $page);
+      }
+      print $page;
     }
   }
   else {
index 0e9a48f..97f7b27 100644 (file)
@@ -446,6 +446,7 @@ tellafriend_n=/cgi-bin/nuser.pl/tellafriend
 [thumb geometries]
 editor=scale(200x200)
 sadmingall=scale(120x120),dropshadow(),canvas(140x140,bgalpha:0),format(png)
+search=scale(150x120)
 
 [file handlers]
 flv=BSE::FileHandler::FLV
index 8c0abcc..af1f504 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::AdminLogon;
 use strict;
 use BSE::Util::Tags qw(tag_error_img);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use BSE::CfgInfo 'admin_base_url';
 
 my %actions =
index 0e2eb39..a53c2fd 100644 (file)
@@ -2,7 +2,7 @@ package BSE::AdminSiteUsers;
 use strict;
 use base qw(BSE::UI::AdminDispatch BSE::UI::SiteuserCommon);
 use BSE::Util::Tags qw(tag_error_img tag_hash);
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use SiteUsers;
 use BSE::Util::Iterate;
 use BSE::Util::DynSort qw(sorter tag_sorthelp);
index f3316f8..1f00ed8 100644 (file)
@@ -2,7 +2,7 @@ package BSE::AdminUsers;
 use strict;
 use BSE::Util::Tags qw/tag_error_img/;
 use BSE::Permissions;
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use BSE::CfgInfo qw(admin_base_url);
 use BSE::Template;
 
index c158626..d5cfbf2 100644 (file)
@@ -1,6 +1,6 @@
 package BSE::Arrows;
 use strict;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 use base 'Exporter';
 
diff --git a/site/cgi-bin/modules/BSE/CGI.pm b/site/cgi-bin/modules/BSE/CGI.pm
new file mode 100644 (file)
index 0000000..85d1423
--- /dev/null
@@ -0,0 +1,56 @@
+package BSE::CGI;
+use strict;
+use Encode;
+
+sub new {
+  my ($class, $q, $charset) = @_;
+
+  my $self = bless
+    {
+     cgi => $q,
+     charset => $charset,
+    }, $class;
+
+  return $self;
+}
+
+sub param {
+  my ($self, @args) = @_;
+
+  my @result = $self->{cgi}->param(@args)
+    or return;
+  for my $value (@result) {
+    $value = decode($self->{charset}, $value);
+  }
+
+  return wantarray && @result > 1 ? @result : $result[0];
+}
+
+sub upload {
+  my ($self, @args) = @_;
+
+  return $self->{cgi}->upload(@args);
+}
+
+sub uploadInfo {
+  my ($self, @args) = @_;
+
+  return $self->{cgi}->uploadInfo(@args);
+}
+
+1;
+
+=head1 NAME
+
+BSE::CGI - CGI.pm wrapper that does character set conversions to perl's internal encoding
+
+=head1 SYNOPSIS
+
+  my $cgi1 = CGI->new;
+  my $cgi = BSE::CGI->new($cgi1, $charset);
+
+=head1 DESCRIPTION
+
+Only provides param(), upload() and uploadInfo().
+
+=cut
index 5dfe3a5..756c606 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::ChangePW;
 use strict;
 use BSE::Util::Tags qw(tag_error_img);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use base 'BSE::UI::AdminDispatch';
 
 my %actions =
index 6f5ccd4..1ebb2eb 100644 (file)
@@ -689,6 +689,19 @@ sub insert_id {
   return $id;
 }
 
+sub dbopts {
+  my ($class) = @_;
+
+  my $opts = $class->SUPER::dbopts();
+
+  if (BSE::Cfg->utf8
+      && lc(BSE::Cfg->charset) eq "utf-8") {
+    $opts->{mysql_enable_utf8} = 1;
+  }
+
+  return $opts;
+}
+
 # gotta love this
 sub DESTROY
 {
index 1bacd1f..39f7f46 100644 (file)
@@ -2,7 +2,7 @@ package BSE::Dynamic::Article;
 use strict;
 use BSE::Util::Tags qw(tag_article);
 use BSE::Template;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use base qw(BSE::Util::DynamicTags);
 
 sub new {
@@ -35,6 +35,11 @@ sub generate {
      type => BSE::Template->get_type($self->{req}->cfg, $article->{template}),
     };
 
+  if (BSE::Cfg->utf8) {
+    require Encode;
+    $result->{content} = Encode::encode(BSE::Cfg->charset, $result->{content});
+  }
+
   %acts = (); # hopefully break circular refs
 
   my @headers = "Content-Length: ".length $result->{content};
index 8f1c611..8fa90f9 100644 (file)
@@ -4,7 +4,7 @@ use base qw(BSE::Edit::Base);
 use BSE::Util::Tags qw(tag_error_img);
 use BSE::Util::SQL qw(now_sqldate now_sqldatetime);
 use BSE::Permissions;
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use BSE::Arrows;
 use BSE::CfgInfo qw(custom_class admin_base_url cfg_image_dir);
 use BSE::Util::Iterate;
@@ -1515,15 +1515,16 @@ sub default_link_path {
 sub make_link {
   my ($self, $article) = @_;
 
+  my $title = $article->title;
   if ($article->is_dynamic) {
-    return "/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($article->{title});
+    return "/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($title);
   }
 
   my $article_uri = $self->link_path($article);
   my $link = "$article_uri/$article->{id}.html";
   my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
   if ($link_titles) {
-    (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
+    (my $extra = $title) =~ tr/a-z0-9/_/sc;
     $link .= "/" . $extra . "_html";
   }
 
@@ -2139,11 +2140,12 @@ sub save_thumbnail {
     unlink("$imagedir/$original->{thumbImage}");
     @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
   }
-  my $image = $cgi->param('thumbnail');
-  if ($image && -s $image) {
+  my $image_name = $cgi->param('thumbnail');
+  my $image = $cgi->upload('thumbnail');
+  if ($image_name && -s $image) {
     # where to put it...
     my $name = '';
-    $image =~ /([\w.-]+)$/ and $name = $1;
+    $image_name =~ /([\w.-]+)$/ and $name = $1;
     my $filename = time . "_" . $name;
 
     use Fcntl;
@@ -2974,7 +2976,7 @@ sub _service_error {
     my $json_result = $req->json_content($result);
 
     if (!exists $ENV{HTTP_X_REQUESTED_WITH}
-       && $ENV{HTTP_X_REQUESTED_WITH} !~ /XMLHttpRequest/) {
+       || $ENV{HTTP_X_REQUESTED_WITH} !~ /XMLHttpRequest/) {
       $json_result->{type} = "text/plain";
     }
 
@@ -3161,12 +3163,13 @@ sub add_image {
       (
        $req->cfg,
        $article,
-       scalar($cgi->param('image')),
+       scalar($cgi->upload('image')),
        name => scalar($cgi->param('name')),
        alt => scalar($cgi->param('altIn')),
        url => scalar($cgi->param('url')),
        storage => scalar($cgi->param('storage')),
        errors => \%errors,
+       filename => scalar($cgi->param("image")),
       );
 
   $imageobj
@@ -3708,7 +3711,8 @@ sub fileadd {
                 section => $article->{id} == -1 ? 'Global File Validation' : 'Article File Validation');
   
   # build a filename
-  my $file = $cgi->param('file');
+  my $file = $cgi->upload('file');
+  my $filename = $cgi->param("file");
   unless ($file) {
     $errors{file} = 'Please enter a filename';
   }
@@ -3741,7 +3745,7 @@ sub fileadd {
     and return $self->edit_form($req, $article, $articles, undef, \%errors);
   
   my $basename = '';
-  my $workfile = $file;
+  my $workfile = $filename;
   $workfile =~ s![^\w.:/\\-]+!_!g;
   $workfile =~ tr/_/_/s;
   $workfile =~ /([ \w.-]+)$/ and $basename = $1;
@@ -3771,91 +3775,6 @@ sub fileadd {
   $@
     and $req->flash($@);
 
-#   my $downloadPath = $self->{cfg}->entryVar('paths', 'downloads');
-
-
-#   unless ($file{contentType}) {
-#     unless ($file =~ /\.([^.]+)$/) {
-#       $file{contentType} = "application/octet-stream";
-#     }
-#     unless ($file{contentType}) {
-#       $file{contentType} = content_type($self->cfg, $file);
-#     }
-#   }
-
-
-#   # if the user supplies a really long filename, it can overflow the 
-#   # filename field
-
-#   my $work_filename = $basename;
-#   if (length $work_filename > 60) {
-#     $work_filename = substr($work_filename, -60);
-#   }
-
-#   my $filename = time. '_'. $work_filename;
-
-#   # for the sysopen() constants
-#   use Fcntl;
-
-#   # loop until we have a unique filename
-#   my $counter="";
-#   $filename = time. '_' . $counter . '_' . $work_filename 
-#     until sysopen( OUTPUT, "$downloadPath/$filename", 
-#                 O_WRONLY| O_CREAT| O_EXCL)
-#       || ++$counter > 100;
-
-#   fileno(OUTPUT) or die "Could not open file: $!";
-
-#   # for OSs with special text line endings
-#   binmode OUTPUT;
-
-#   my $buffer;
-
-#   no strict 'refs';
-
-#   # read the image in from the browser and output it to our output filehandle
-#   print OUTPUT $buffer while read $file, $buffer, 8192;
-
-#   # close and flush
-#   close OUTPUT
-#     or die "Could not close file $filename: $!";
-
-#   use BSE::Util::SQL qw/now_datetime/;
-#   $file{filename} = $filename;
-#   $file{displayName} = $basename;
-#   $file{sizeInBytes} = -s $file;
-#   $file{displayOrder} = time;
-#   $file{whenUploaded} = now_datetime();
-#   $file{storage}        = 'local';
-#   $file{src}            = '';
-#   $file{file_handler}   = "";
-
-#   require BSE::TB::ArticleFiles;
-#   my $fileobj = BSE::TB::ArticleFiles->add(@file{@cols});
-
-#   my $storage = $cgi->param('storage');
-#   defined $storage or $storage = 'local';
-#   my $file_manager = $self->_file_manager($req->cfg);
-
-#   local $SIG{__DIE__};
-#   eval {
-#     my $src;
-#     $storage = $self->_select_filestore($req, $file_manager, $storage, $fileobj);
-#     $src = $file_manager->store($filename, $storage, $fileobj);
-
-#     if ($src) {
-#       $fileobj->{src} = $src;
-#       $fileobj->{storage} = $storage;
-#       $fileobj->save;
-#     }
-#   };
-#   if ($@) {
-#     $req->flash($@);
-#   }
-
-#   $fileobj->set_handler($req->cfg);
-#   $fileobj->save;
-
   use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
index c7dbf64..1c7b130 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::Edit::Catalog;
 use strict;
 use base 'BSE::Edit::Article';
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 sub base_template_dirs {
   return ( "catalog" );
index 5ba8325..3014b52 100644 (file)
@@ -5,7 +5,7 @@ use Products;
 use HTML::Entities;
 use BSE::Template;
 use BSE::Util::Iterate;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use BSE::CfgInfo 'product_options';
 use BSE::Util::Tags qw(tag_hash);
 
index 66bd751..b5f8c27 100644 (file)
@@ -6,7 +6,7 @@ use BSE::Util::Tags qw(tag_hash tag_hash_mbcs tag_hash_plain);
 use BSE::Util::SQL qw(now_sqldatetime);
 use DevHelp::Date qw(dh_parse_date_sql dh_parse_time_sql);
 use constant SECT_SEMSESSION_VALIDATION => 'BSE Seminar Session Validation';
-use DevHelp::HTML qw(escape_html);
+use BSE::Util::HTML qw(escape_html);
 use BSE::Util::Iterate;
 
 sub article_actions {
index f75d1f8..1686233 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::FileHandler::Default;
 use strict;
 use base "BSE::FileHandler::Base";
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 sub process_file {
   my ($self, $file) = @_;
index da3a046..8fab547 100644 (file)
@@ -2,7 +2,7 @@ package BSE::FileHandler::FLV;
 use strict;
 use base "BSE::FileHandler::Base";
 use BSE::Util::Tags qw(tag_hash);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 sub process_file {
   my ($self, $file) = @_;
index 27bdb42..01ea8e7 100644 (file)
@@ -1,6 +1,6 @@
 package BSE::Formatter;
 use strict;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use Carp 'confess';
 
 use base 'DevHelp::Formatter';
index 8f1cf26..430e1fe 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::Formatter::Article;
 use strict;
 use base 'BSE::Formatter';
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use Digest::MD5 qw(md5_hex);
 
 sub link {
index df247c8..f01925b 100644 (file)
@@ -2,7 +2,7 @@ package BSE::Generate::Seminar;
 use strict;
 use base 'Generate::Product';
 use BSE::TB::Seminars;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use BSE::Util::Tags qw(tag_article);
 use BSE::Util::Iterate;
 
index ce31296..339a9de 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::ImageHandler::Flash;
 use strict;
 use base 'BSE::ImageHandler::Base';
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use Carp qw(confess);
 
 my @flash_opts = qw/quality wmode id play loop menu bgcolor flashvars class/;
index 81a7832..57a74ad 100644 (file)
@@ -2,7 +2,7 @@ package BSE::ImageHandler::Img;
 use strict;
 use base 'BSE::ImageHandler::Base';
 use Carp qw(confess);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 sub thumb_base_url {
   '/cgi-bin/thumb.pl';
index 1746d73..8f03003 100644 (file)
@@ -194,6 +194,8 @@ sub _get_base {
     $self->{cache}->set("msg-$key", $entry);
   }
 
+  $msg or return;
+
   # clone so the caller doesn't modify cached value
   my %entry = %$msg;
   return \%entry;
index b9f1d61..3e931a9 100644 (file)
@@ -2,7 +2,7 @@ package BSE::Request::Base;
 use strict;
 use CGI ();
 use BSE::Cfg;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use Carp qw(cluck confess);
 
 sub new {
@@ -21,16 +21,7 @@ sub new {
   $opts{cgi} ||= $self->_make_cgi;
   $opts{fastcgi} ||= 0;
 
-  if ($self->cfg->entry('html', 'utf8decodeall')) {
-    $self->_encode_utf8();
-  }
-  elsif ($self->cfg->entry('html', 'ajaxcharset', 0)
-      && $self->is_ajax) {
-    # convert the values of each parameter from UTF8 to iso-8859-1
-    $self->_convert_utf8_cgi_to_charset();
-  }
-
-  $self;
+  return $self;
 }
 
 sub _tracking_uploads {
@@ -98,26 +89,22 @@ sub _make_cgi {
       && $ENV{CONTENT_TYPE}
       && $ENV{CONTENT_TYPE} =~ m(^multipart/form-data)
       && $ENV{CONTENT_LENGTH}
+      && $ENV{QUERY_STRING}
+      && $ENV{QUERY_STRING} =~ /^_upload=([a-zA-Z0-9_]+)$/
       && defined ($cache = $self->_cache_object)) {
     # very hacky
+    my $upload_key = $1;
+    my $fullkey = "upload-$upload_key";
     my $q;
     my $done = 0;
     my $last_set = time();
-    my $upload_key;
-    if ($ENV{QUERY_STRING}
-       && $ENV{QUERY_STRING} =~ /^_upload=([a-zA-Z0-9_]+)$/) {
-      $upload_key = $1;
-    }
     my $complete = 0;
     eval {
       $q = CGI->new
        (
         sub {
           my ($filename, $data, $size_so_far) = @_;
-          
-          $upload_key ||= $q->param("_upload");
-          $upload_key or return;
-          my $fullkey = "upload-$upload_key";
+
           $done += length $data;
           my $now = time;
           if ($last_set + 1 <= $now) { # just in case we end up loading Time::HiRes
@@ -140,26 +127,26 @@ sub _make_cgi {
       $complete = 1;
     };
 
-    if ($upload_key) {
-      my $fullkey = "upload-$upload_key";
-      
-      if ($complete) {
-       $cache->set($fullkey,
-                   {
-                    done => $ENV{CONTENT_LENGTH},
-                    total => $ENV{CONTENT_LENGTH},
-                    complete => 1,
-                   });
-      }
-      else {
-       $cache->set($fullkey,
-                   {
-                    failed => 1,
-                   });
-       die;
-      }
+    if ($complete) {
+      $cache->set($fullkey,
+                 {
+                  done => $ENV{CONTENT_LENGTH},
+                  total => $ENV{CONTENT_LENGTH},
+                  complete => 1,
+                 });
+    }
+    else {
+      $cache->set($fullkey,
+                 {
+                  failed => 1,
+                 });
+      die;
+    }
+
+    if ($self->utf8) {
+      require BSE::CGI;
+      return BSE::CGI->new($q, $self->charset);
     }
 
     return $q;
   }
@@ -170,6 +157,11 @@ sub _make_cgi {
     print STDERR "CGI ERROR: $error\n";
   }
 
+  if ($self->utf8) {
+    require BSE::CGI;
+    return BSE::CGI->new($q, $self->charset);
+  }
+
   return $q;
 }
 
@@ -429,7 +421,7 @@ sub siteuser {
 
     my $userid = $session->{userid}
       or return;
-    my $user = SiteUsers->getBy(userId=>$userid)
+    my $user = SiteUsers->getByPkey($userid)
       or return;
     $user->{disabled}
       and return;
@@ -909,6 +901,10 @@ sub json_content {
 
   my $json = JSON->new;
 
+  if ($self->utf8) {
+    $json->utf8;
+  }
+
   my $value = @values > 1 ? +{ @values } : $values[0];
   my ($context) = $self->cgi->param("_context");
   if (defined $context) {
@@ -1057,6 +1053,16 @@ sub audit {
   return BSE::TB::AuditLog->log(%opts);
 }
 
+sub utf8 {
+  my $self = shift;
+  return $self->cfg->utf8;
+}
+
+sub charset {
+  my $self = shift;
+  return $self->cfg->charset;
+}
+
 =item message_catalog
 
 Retrieve the message catalog.
index 3b215a9..6dc25f9 100644 (file)
@@ -10,7 +10,7 @@ use BSE::Util::SQL qw(now_sqldate);
 use BSE::Util::Tags;
 use BSE::CfgInfo qw(custom_class);
 use Carp 'confess';
-use DevHelp::HTML qw(escape_html);
+use BSE::Util::HTML qw(escape_html);
 
 =item shop_cart_tags($acts, $cart, $cart_prods, $req, $stage)
 
index 78ca978..7541d81 100644 (file)
@@ -220,13 +220,13 @@ sub inline {
     $meta->content_type eq "text/plain"
       or return "* metadata $name isn't text *";
 
-    require DevHelp::HTML;
-    return DevHelp::HTML::escape_html($meta->value);
+    require BSE::Util::HTML;
+    return BSE::Util::HTML::escape_html($meta->value);
   }
   elsif ($field eq "link" || $field eq "url") {
     my $url = "/cgi-bin/user.pl?download_file=1&file=$file->{id}";
-    require DevHelp::HTML;
-    my $eurl = DevHelp::HTML::escape_html($url);
+    require BSE::Util::HTML;
+    my $eurl = BSE::Util::HTML::escape_html($url);
     if ($field eq 'url') {
       return $eurl;
     }
index 54e0266..9c1e3f8 100644 (file)
@@ -5,7 +5,7 @@ use Squirrel::Row;
 use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row/;
 use Carp qw(confess);
-use DevHelp::HTML qw(escape_html);
+use BSE::Util::HTML qw(escape_html);
 
 sub columns {
   return qw/id articleId image alt width height url displayOrder name
index da4acbe..c773676 100644 (file)
@@ -1,6 +1,6 @@
 package BSE::TagFormats;
 use strict;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 sub _format_image {
   my ($self, $im, $align, $rest) = @_;
index 794da6e..9185b76 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::Template;
 use strict;
 use Squirrel::Template;
-use Carp 'confess';
+use Carp qw(confess cluck);
 use Config ();
 
 sub templater {
@@ -62,12 +62,23 @@ sub replace {
   $obj->replace_template($source, $acts);
 }
 
+sub charset {
+  my ($class, $cfg) = @_;
+
+  return $cfg->charset;
+}
+
+sub utf8 {
+  my ($class, $cfg) = @_;
+
+  return $cfg->utf8;
+}
+
 sub html_type {
   my ($class, $cfg) = @_;
 
   my $type = "text/html";
-  my $charset = $cfg->entry('html', 'charset');
-  $charset = 'iso-8859-1' unless defined $charset;
+  my $charset = $class->charset($cfg);
   return $type . "; charset=$charset";
 }
 
@@ -102,11 +113,23 @@ sub show_literal {
 sub get_response {
   my ($class, $template, $cfg, $acts, $base_template, $rsets) = @_;
 
+  my $content = $class->get_page($template, $cfg, $acts,
+                                $base_template, $rsets);
+  if ($class->utf8($cfg)) {
+    my $charset = $class->charset($cfg);
+
+    require Encode;
+    Encode->import();
+    my $check = $cfg->entry("utf8", "check", Encode::FB_DEFAULT());
+    $check = oct($check) if $check =~ /^0/;
+
+    $content = Encode::encode($charset, $content, $check);
+  }
+
   my $result =
     {
      type => $class->get_type($cfg, $template),
-     content => scalar($class->get_page($template, $cfg, $acts, 
-                                       $base_template, $rsets)),
+     content => $content,
     };
   push @{$result->{headers}}, "Content-Length: ".length($result->{content});
 
@@ -178,11 +201,15 @@ sub get_source {
 
   my $path = $class->find_source($template, $cfg)
     or confess "Cannot find template $template";
-  open SOURCE, "< $path"
+  open my $source, "< $path"
     or confess "Cannot open template $path: $!";
-  binmode SOURCE;
-  my $html = do { local $/; <SOURCE> };
-  close SOURCE;
+  binmode $source;
+  if ($cfg->utf8) {
+    my $charset = $cfg->charset;
+    binmode $source, ":encoding($charset)";
+  }
+  my $html = do { local $/; <$source> };
+  close $source;
 
   $html;
 }
@@ -257,6 +284,9 @@ sub output_resultc {
     print "\n";
   }
   if (defined $result->{content}) {
+    if ($result->{content} =~ /([^\x00-\xff])/) {
+      cluck "Wide character in content (\\x{", sprintf("%X", ord $1), "})";
+    }
     print $result->{content};
   }
   elsif ($result->{content_fh}) {
index 6386d5b..60cfa6a 100644 (file)
@@ -1,6 +1,5 @@
 package BSE::ThumbLow;
 use strict;
-use DevHelp::HTML;
 
 sub _thumbimage_low {
   my ($self, $geo_id, $im, $field, $cfg, $static) = @_;
index 0e7bed8..3085803 100644 (file)
@@ -4,7 +4,7 @@ use BSE::SubscriptionTypes;
 use BSE::Util::Tags qw(tag_hash);
 use Articles;
 use BSE::Message;
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use BSE::Util::Iterate;
 use base 'BSE::UI::AdminDispatch';
 
index d25f414..01a3f81 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use base 'BSE::UI::AdminDispatch';
 use BSE::Util::Tags;
 use BSE::Report;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 my %actions =
   (
index b3ef26c..bc2731e 100644 (file)
@@ -6,7 +6,7 @@ use BSE::Util::DynSort qw(sorter tag_sorthelp);
 use BSE::Template;
 use BSE::Util::Iterate;
 use BSE::TB::Locations;
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use constant SECT_LOCATION_VALIDATION => "BSE Location Validation";
 use BSE::CfgInfo 'product_options';
 use DevHelp::Date qw(dh_strftime_sql_datetime);
index ae5f937..9760080 100644 (file)
@@ -15,7 +15,7 @@ use BSE::Sort;
 use BSE::Util::Tags qw(tag_hash);
 use BSE::Util::Iterate;
 use BSE::WebUtil 'refresh_to_admin';
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use BSE::Arrows;
 use BSE::Shop::Util qw(order_item_opts nice_options);
 
index 4a9f031..91f05a1 100644 (file)
@@ -2,7 +2,7 @@ package BSE::UI::Affiliate;
 use strict;
 use base qw(BSE::UI::Dispatch BSE::UI::SiteuserCommon);
 use BSE::Util::Tags qw(tag_hash);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 my %actions =
   (
index fe092f2..50d80cc 100644 (file)
@@ -5,7 +5,7 @@ use BSE::TB::BackgroundTasks;
 use BSE::Util::Iterate;
 use BSE::Util::Tags;
 use BSE::Util::SQL qw(now_sqldatetime);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use IO::File;
 use BSE::Util::Tags qw(tag_hash);
 use Config;
index 7bc5441..24720bd 100644 (file)
@@ -2,7 +2,7 @@ package BSE::UI::Formmail;
 use strict;
 use base qw(BSE::UI::Dispatch);
 use BSE::Util::Tags qw(tag_hash tag_hash_plain tag_error_img);
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use DevHelp::Validate qw(dh_validate dh_configure_fields);
 use BSE::Util::Iterate;
 use constant DISPLAY_TIMEOUT => 300;
index 9db2256..2fa2b1e 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use Articles;
 use BSE::TB::Images;
 use BSE::Util::Tags qw(tag_hash);
-use DevHelp::HTML qw(escape_uri);
+use BSE::Util::HTML qw(escape_uri);
 
 # we don't do anything fancy on dispatch yet, so don't use the 
 # dispatch classes
index 2544eca..2a41821 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::UI::Page;
 use strict;
 use Articles;
-use DevHelp::HTML qw(escape_uri);
+use BSE::Util::HTML qw(escape_uri);
 use BSE::UI::Dispatch;
 our @ISA = qw(BSE::UI::Dispatch);
 
@@ -46,10 +46,10 @@ sub dispatch {
       (my $url = $ENV{SCRIPT_URL}) =~ s(^\Q$prefix\E/)();
       my ($alias) = $url =~ /^([a-zA-Z0-9_]+)/
        or return $self->error($req, "Missing document $ENV{SCRIPT_URL}");
-      
+
       $article = Articles->getBy(linkAlias => $alias)
        or return $self->error($req, "Unknown article alias '$alias'");
-      
+
       # have the client treat this as successful, though an error is
       # still written to the Apache error log
       push @more_headers, "Status: 200";
@@ -100,16 +100,12 @@ sub dispatch {
   if ($cfg->entry('basic', 'alias_use_static', 1)
       && !$article->is_dynamic
       && -r (my $file = $article->link_to_filename($cfg))) {
-    if (open DOC, "< $file") {
-      my $content = do { local $/; <DOC> };
-      close DOC;
-      return
-       {
-        content => $content,
-        type => BSE::Template->get_type($cfg, $article->{template}),
-        no_cache_dynamic => $no_cache_dynamic,
-       };
-    }
+    return
+      {
+       content_filename => $file,
+       type => BSE::Template->get_type($cfg, $article->{template}),
+       no_cache_dynamic => $no_cache_dynamic,
+      };
   }
 
   # get the dynamic generate for this article type
@@ -147,10 +143,14 @@ sub dispatch {
   my $dynamic_pregen = $cfg->entry('basic', 'jit_dynamic_pregen');
   my $template;
   if (-e $srcname) {
-    if (open SRC, "< $srcname") {
+    if (open my $src, "< $srcname") {
       local $/;
-      $template = <SRC>;
-      close SRC;
+      if ($cfg->utf8) {
+       my $charset = $cfg->charset;
+       binmode $src, ":encoding($charset)";
+      }
+      $template = <$src>;
+      close $src;
     }
     else {
       print STDERR "** PAGE: $id - page file exists but isn't readable\n";
@@ -187,10 +187,14 @@ sub _generate_pregen {
 
   my $content = $gen->generate($article, $articles);
 
-  if (open CONTENT, "> $srcname") {
-    binmode CONTENT;
-    print CONTENT $content;
-    close CONTENT;
+  if (open my $cfile, "> $srcname") {
+    binmode $cfile;
+    if ($req->cfg->utf8) {
+      my $charset = $req->cfg->charset;
+      binmode $cfile, ":encoding($charset)";
+    }
+    print $cfile $content;
+    close $cfile;
   }
   else {
     print STDERR "** PAGE: $article->{id} - cannot create $srcname: $!\n";
index ada2f68..ec5ce1a 100644 (file)
@@ -2,7 +2,7 @@ package BSE::UI::Redirect;
 use strict;
 use base qw(BSE::UI::Dispatch);
 use Digest::MD5 qw(md5_hex);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 my %actions =
   (
index 8840223..38bb276 100644 (file)
@@ -7,7 +7,7 @@ use Constants qw(:search);
 use Carp;
 use BSE::Cfg;
 use BSE::Template;
-use DevHelp::HTML qw':default popup_menu';
+use BSE::Util::HTML qw':default popup_menu';
 use BSE::Util::Tags qw(tag_article);
 use BSE::Request;
 
@@ -268,10 +268,12 @@ sub req_search {
      sub { $page_num_iter == $page_number },
      pageurl => 
      sub {
-       $ENV{SCRIPT_NAME} . "?q=" . escape_uri($words) . 
+       my $work_words = $words;
+       $ENV{SCRIPT_NAME} . "?q=" . escape_uri($work_words) .
         "&amp;s=" . escape_uri($section) .
           "&amp;d=" . escape_uri($date) .
-            "&amp;page=".$page_num_iter;
+            "&amp;page=".$page_num_iter .
+              "&amp;pp=$results_per_page";
      },
      highlight_result =>
      [ \&tag_highlight_result, \$current_result, $cfg, $words_re ],
index 754707d..aef60a2 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::UI::Shop;
 use strict;
 use base 'BSE::UI::Dispatch';
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use BSE::Util::SQL qw(now_sqldate now_sqldatetime);
 use BSE::Shop::Util qw(need_logon shop_cart_tags payment_types nice_options 
                        cart_item_opts basic_tags order_item_opts);
index 35c9833..7c28bd1 100644 (file)
@@ -5,7 +5,7 @@ use BSE::Template;
 use SiteUsers;
 use BSE::Util::Iterate;
 use BSE::Util::Tags qw(tag_error_img);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use DevHelp::Validate;
 use BSE::Util::Secure qw/make_secret/;
 use BSE::SubscribedUsers;
index 6fc76c7..7f2dd74 100644 (file)
@@ -1,6 +1,6 @@
 package BSE::UI::SiteuserCommon;
 use strict;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use BSE::Util::Tags qw(tag_hash);
 
 use constant MAXWIDTH => 10000;
index 2ba88c7..2e352c3 100644 (file)
@@ -7,7 +7,7 @@ use DevHelp::Validate qw(dh_validate);
 use BSE::Template;
 use BSE::Util::Iterate;
 use BSE::TB::Subscriptions;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 my %rights =
   (
index d4dfbba..6ea3cb0 100644 (file)
@@ -2,7 +2,7 @@ package BSE::UI::User;
 use strict;
 use base 'BSE::UI::Dispatch';
 use BSE::Util::Tags qw(tag_hash tag_error_img tag_hash_plain);
-use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::HTML qw(:default popup_menu);
 use BSE::Util::Iterate;
 use BSE::Util::SQL qw/now_datetime/;
 use DevHelp::Date qw(dh_strftime_sql_datetime);
index 838faaf..14e0f28 100644 (file)
@@ -11,11 +11,12 @@ use BSE::SubscribedUsers;
 use BSE::Mail;
 use BSE::EmailRequests;
 use BSE::Util::SQL qw/now_datetime/;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use BSE::CfgInfo qw(custom_class);
 use BSE::WebUtil qw/refresh_to/;
 use BSE::Util::Iterate;
 use base 'BSE::UI::UserCommon';
+use Carp qw(confess);
 
 use constant MAX_UNACKED_CONF_MSGS => 3;
 use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
@@ -108,8 +109,7 @@ sub req_show_logon {
      message => sub { CGI::escapeHTML($message) },
     );
 
-  BSE::Template->show_page('user/logon', $cfg, \%acts);
-  return;
+  return $req->response('user/logon', \%acts);
 }
 
 sub req_logon {
@@ -158,11 +158,11 @@ sub req_logon {
   _validate_affiliate_name($cfg, $user->{affiliate_name}, \%errors, $msgs, $user);
   if (keys %errors) {
     delete $session->{userid};
-    $session->{partial_logon} = $user->{userId};
+    $session->{partial_logon} = $user->id;
     return $self->req_show_opts($req, undef, \%errors);
   }
 
-  $session->{userid} = $user->{userId};
+  $session->{userid} = $user->id;
   $user->{previousLogon} = $user->{lastLogon};
   $user->{lastLogon} = now_datetime;
   $user->save;
@@ -384,18 +384,13 @@ sub req_show_register {
     );
 
   my $template = 'user/register';
-  my $t = $cgi->param('_t');
-  if ($t && $t =~ /^\w+$/ && $t ne 'base') {
-    $template .= "_$t";
-  }
-
-  BSE::Template->show_page($template, $cfg, \%acts);
-
-  return;
+  return $req->dyn_response($template, \%acts);
 }
 
 sub _get_user {
-  my ($self, $req, $name) = @_;
+  my ($self, $req, $name, $result) = @_;
+
+  defined $result or confess "Missing result parameter";
 
   my $cfg = $req->cfg;
   my $cgi = $req->cgi;
@@ -414,7 +409,7 @@ sub _get_user {
 
     $user->{password} eq $password
       or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
-    
+
     return $user;
   }
   else {
@@ -424,11 +419,16 @@ sub _get_user {
       return $custom->siteuser_auth($session, $cgi, $cfg);
     }
     else {
-      my $user = $req->siteuser
-       or do { $self->req_show_logon($req); return };
-      $user->{disabled}
-       and do { $self->req_show_logon($req, "Account disabled"); return };
-      
+      my $user = $req->siteuser;
+      unless ($user) {
+       $$result = $self->req_show_logon($req);
+       return;
+      }
+      if ($user->{disabled}) {
+       $$result = $self->req_show_logon($req, "Account disabled");
+       return;
+      }
+
       return $user;
     }
   }
@@ -473,8 +473,9 @@ sub req_show_opts {
   }
 
   unless ($user) {
-    $user = $self->_get_user($req, 'show_opts')
-      or return;
+    my $result;
+    $user = $self->_get_user($req, 'show_opts', \$result)
+      or return $result;
   }
   
   my @subs = grep $_->{visible}, BSE::SubscriptionTypes->all;
@@ -541,16 +542,8 @@ sub req_show_opts {
     );
 
   my $base = 'user/options';
-  my $template = $base;
 
-  my $t = $cgi->param('_t');
-  if ($t && $t =~ /^\w+$/) {
-    $template .= "_$t";
-  }
-
-  BSE::Template->show_page($template, $cfg, \%acts, $base);
-
-  return;
+  return $req->dyn_response($base, \%acts);
 }
 
 sub _checkemail {
@@ -615,8 +608,9 @@ sub req_saveopts {
     and ++$partial_logon;
 
   unless ($user) {
-    $user = $self->_get_user($req)
-      or return;
+    my $result;
+    $user = $self->_get_user($req, undef, \$result)
+      or return $result;
   }
 
   my $custom = custom_class($cfg);
@@ -756,7 +750,7 @@ sub req_saveopts {
   if ($partial_logon) {
     $user->{previousLogon} = $user->{lastLogon};
     $user->{lastLogon} = now_datetime;
-    $session->{userid} = $user->{userId};
+    $session->{userid} = $user->id;
     delete $session->{partial_logon};
     $user->save;
 
@@ -979,7 +973,7 @@ sub req_register {
 
     $self->_send_user_cookie($user);
     unless ($nopassword) {
-      $session->{userid} = $user->{userId};
+      $session->{userid} = $user->id;
       my $custom = custom_class($cfg);
       if ($custom->can('siteuser_login')) {
        $custom->siteuser_login($session->{_session_id}, $session->{userid}, $cfg);
@@ -1073,8 +1067,9 @@ sub req_userpage {
     $message = $req->message;
   }
 
-  my $user = $self->_get_user($req, 'userpage')
-    or return;
+  my $result;
+  my $user = $self->_get_user($req, 'userpage', \$result)
+    or return $result;
   require BSE::TB::Orders;
   my @orders = sort { $b->{orderDate} cmp $a->{orderDate}
                        || $b->{id} <=> $a->{id} }
@@ -1145,14 +1140,16 @@ sub req_userpage {
                        'booking', 'bookings'),
     );
   my $base_template = 'user/userpage';
-  my $template = $base_template;
-  my $t = $cgi->param('_t');
-  if (defined $t && $t =~ /^\w+$/) {
-    $template = $template . '_' . $t;
-  }
-  BSE::Template->show_page($template, $cfg, \%acts, $base_template);
-
-  return;
+#   my $template = $base_template;
+#   my $t = $cgi->param('_t');
+#   if (defined $t && $t =~ /^\w+$/) {
+#     $template = $template . '_' . $t;
+#   }
+
+  return $req->dyn_response($base_template, \%acts);
+#  BSE::Template->show_page($template, $cfg, \%acts, $base_template);
+#
+#  return;
 }
 
 sub tag_detail_product {
@@ -1194,8 +1191,9 @@ sub req_orderdetail {
   my $cgi = $req->cgi;
   my $session = $req->session;
 
-  my $user = $self->_get_user($req, 'userpage')
-    or return;
+  my $result;
+  my $user = $self->_get_user($req, 'userpage', \$result)
+    or return $result;
   my $order_id = $cgi->param('id');
   my $order;
   if (defined $order_id && $order_id =~ /^\d+$/) {
@@ -1240,14 +1238,8 @@ sub req_orderdetail {
     );
 
   my $base_template = 'user/orderdetail';
-  my $template = $base_template;
-  my $t = $cgi->param('_t');
-  if (defined $t && $t =~ /^\w+$/) {
-    $template = $template . '_' . $t;
-  }
-  BSE::Template->show_page($template, $cfg, \%acts, $base_template);
 
-  return;
+  return $req->dyn_response($base_template, \%acts);
 }
 
 sub req_download {
@@ -1258,8 +1250,9 @@ sub req_download {
   my $session = $req->session;
 
   my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
-  my $user = $self->_get_user($req, 'show_opts')
-    or return;
+  my $result;
+  my $user = $self->_get_user($req, 'show_opts', \$result)
+    or return $result;
 
   my $orderid = $cgi->param('order')
     or return _refresh_userpage($cfg, $msgs->('noorderid', "No order id supplied"));
@@ -1336,7 +1329,7 @@ sub req_download_file {
   my $userid = $session->{userid};
   my $user;
   if ($userid) {
-    $user = SiteUsers->getBy(userId=>$userid);
+    $user = SiteUsers->getByPkey($userid);
   }
   $fileid ||= $cgi->param('file')
     or return $self->req_show_logon($req, 
@@ -1528,11 +1521,6 @@ sub req_show_lost_password {
 
   $message ||= $cgi->param('message') || '';
   $message = escape_html($message);
-  my $userid = $session->{userid};
-  my $user;
-  if ($userid) {
-    $user = SiteUsers->getBy(userId=>$userid);
-  }
 
   my %acts;
   %acts =
@@ -2118,8 +2106,9 @@ sub req_downufile {
   my $file = BSE::TB::OwnedFiles->getByPkey($id)
     or return $self->error($req, "Invalid or missing file id");
 
-  my $user = $self->_get_user($req, 'downufile')
-    or return;
+  my $result;
+  my $user = $self->_get_user($req, 'downufile', \$result)
+    or return $result;
 
   require BSE::TB::SiteUserGroups;
   my $accessible = 0;
index 1286f0c..f8bce1f 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::Util::DynamicTags;
 use strict;
 use BSE::Util::Tags qw(tag_article);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use base 'BSE::ThumbLow';
 use base 'BSE::TagFormats';
 use BSE::CfgInfo qw(custom_class);
diff --git a/site/cgi-bin/modules/BSE/Util/HTML.pm b/site/cgi-bin/modules/BSE/Util/HTML.pm
new file mode 100644 (file)
index 0000000..64d7e48
--- /dev/null
@@ -0,0 +1,194 @@
+package BSE::Util::HTML;
+use strict;
+use BSE::Cfg;
+use Carp qw(confess);
+
+require Exporter;
+use vars qw(@EXPORT_OK @EXPORT @ISA %EXPORT_TAGS);
+@EXPORT_OK = qw(escape_html escape_uri unescape_html unescape_uri popup_menu escape_xml);
+@EXPORT = qw(escape_html escape_uri unescape_html unescape_uri);
+%EXPORT_TAGS =
+  (
+   all => \@EXPORT_OK,
+   default => \@EXPORT,
+  );
+@ISA = qw(Exporter);
+
+use HTML::Entities ();
+use URI::Escape ();
+
+sub escape_html {
+  my ($text, $what) = @_;
+
+  $what ||= '<>&"\x7F';
+
+  HTML::Entities::encode($text, $what);
+}
+
+sub unescape_html {
+  HTML::Entities::decode(shift);
+}
+
+my %xml_entities = qw(< lt > gt & amp " quot);
+
+sub escape_xml {
+  my ($text) = @_;
+
+  $text =~ s/([<>&\"\x7F])/$xml_entities{$1} ? "&$xml_entities{$1};" : "&#".ord($1).";"/ge;
+
+  return $text;
+}
+
+sub escape_uri {
+  my ($text) = @_;
+
+  if (BSE::Cfg->utf8) {
+    require Encode;
+    $text = Encode::encode(BSE::Cfg->charset, $text);
+  }
+  # older versions of uri_escape() acted differently without the
+  # second argument, so supply one to make sure we escape what
+  # needs escaping
+  return URI::Escape::uri_escape($text, "^A-Za-z0-9\-_.!~*()");
+}
+
+sub unescape_uri {
+  my ($text) = @_;
+
+  if (BSE::Cfg->utf8) {
+    $text = URI::Escape::uri_unescape($text);
+    require Encode;
+    return Encode::decode(BSE::Cfg->charset, $text);
+  }
+  else {
+    return URI::Escape::uri_unescape($text);
+  }
+}
+
+sub _options {
+  my ($values, $labels, $default) = @_;
+
+  my $html = '';
+  for my $value (@$values) {
+    my $option = '<option value="' . escape_html($value) . '"';
+    my $label = $labels->{$value};
+    defined $label or $label = $value;
+    $option .= ' selected="selected"'
+      if defined($default) && $default eq $value;
+    $option .= '>' . escape_html($label) . "</option>";
+    $html .= $option . "\n";
+  }
+
+  return $html;
+}
+
+sub popup_menu {
+  my (%opts) = @_;
+
+  exists $opts{'-name'}
+    or confess "No -name parameter";
+
+  my $html = '<select name="' . escape_html($opts{"-name"}) . '"';
+  $html .= ' id="'.escape_html($opts{'-id'}).'"' if $opts{'-id'};
+  $html .= '>';
+  my $labels = $opts{"-labels"} || {};
+  my $values = $opts{"-values"};
+  my $default = $opts{"-default"};
+  my $groups = $opts{"-groups"};
+  if ($groups) {
+    for my $group (@$groups) {
+      my ($label, $ids) = @$group;
+      if (length $label) {
+       $html .= '<optgroup label="' . escape_html($label) . '">'
+         . _options($ids, $labels, $default) . '</optgroup>';
+      }
+      else {
+       $html .= _options($ids, $labels, $default);
+      }
+    }
+  }
+  else {
+    $html .= _options($values, $labels, $default);
+  }
+  $html .= "</select>";
+
+  $html;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+BSE::Util::HTML - provides simple consistent interfaces to HTML/URI
+escaping with some extras
+
+=head1 SYNOPSIS
+
+  use BSE::Util::HTML;
+
+  my $escaped = escape_html($text);
+  my $escaped = escape_uri($text);
+  my $unescaped = unescape_html($text);
+  my $unescaped = unescape_uri($text);
+  my $html = popup_menu(-name => $name,
+                        -values => \@values,
+                       -labels => \%labels,
+                       -default => $default);
+
+=head1 DESCRIPTION
+
+Provides some of the functionality of the CGI.pm module, without the
+code to get the query/POST parameters.
+
+This is a BSE specific version of DevHelp::HTML that depends on BSE's
+configuration to do the right thing with character strings, as opposed
+to BSE's historic octet strings.
+
+=over
+
+=item escape_html($text)
+
+=item escape_html($text, $what)
+
+Escape $text using HTML escapes.  Expected characters as input,
+returns characters (not octets).
+
+=item unescape_html($text)
+
+Converts entities to characters, returning the characters.
+
+=item escape_xml($text)
+
+Escape only <, >, & and ".
+
+=cut
+
+=item escape_uri($text)
+
+Escapes $text given as characters.
+
+When BSE's utf8 flag is enabled the characters are first converted to
+the BSE character set then URI escaped.
+
+=item unescape_uri($text)
+
+Unescape URI escapes in $text and returns characters.
+
+When BSE's utf8 flag is enabled the octets resulting from URI
+unescaping are decoded to perl's internal character representation.
+
+=item popup_menu(...)
+
+Creates a C<select> form element.  Same interface as CGI::popup_menu()
+but without the need to use -override to make the -default option
+useful.
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
index d89bed2..31b575f 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::Util::Iterate;
 use strict;
 use base 'DevHelp::Tags::Iterate';
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use Carp 'confess';
 
 sub escape {
index 36b3a94..2c66f3e 100644 (file)
@@ -2,7 +2,7 @@ package BSE::Util::Tags;
 use strict;
 use HTML::Entities;
 use DevHelp::Tags;
-use DevHelp::HTML qw(:default escape_xml);
+use BSE::Util::HTML qw(:default escape_xml);
 use vars qw(@EXPORT_OK @ISA);
 @EXPORT_OK = qw(tag_error_img tag_hash tag_hash_plain tag_hash_mbcs tag_article tag_article_plain tag_object);
 @ISA = qw(Exporter);
index 3237f2e..37424fb 100644 (file)
@@ -19,7 +19,7 @@ use URI::Escape ();
 sub escape_html {
   my ($text, $what) = @_;
 
-  $what ||= '<>&"\x7F-\xFF';
+  $what ||= '<>&"\x7F';
 
   HTML::Entities::encode($text, $what);
 }
index a8d27a6..0073c8a 100644 (file)
@@ -4,7 +4,7 @@ use Articles;
 use Constants qw($IMAGEDIR $LOCAL_FORMAT $BODY_EMBED 
                  $EMBED_MAX_DEPTH $HAVE_HTML_PARSER);
 use DevHelp::Tags;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use BSE::Util::Tags qw(tag_article);
 use BSE::CfgInfo qw(custom_class);
 use BSE::Util::Iterate;
index 506a7c4..3b93474 100644 (file)
@@ -10,7 +10,7 @@ use Util qw(generate_button);
 use BSE::Util::Tags qw(tag_article);
 use BSE::TB::ArticleFiles;
 @ISA = qw/Generate/;
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use BSE::Arrows;
 use Carp 'confess';
 use BSE::Util::Iterate;
index 21f76f1..003198f 100644 (file)
@@ -6,7 +6,7 @@ use BSE::TB::Images;
 use base qw(Generate::Article);
 use Constants qw(:shop $CGI_URI $ADMIN_URI);
 use Carp qw(confess);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 use BSE::Util::Tags qw(tag_article);
 
 sub edit_link {
@@ -74,7 +74,7 @@ sub baseActs {
           );
         push(@args, -labels=>$option->{labels}) if $option->{labels};
         push(@args, -default=>$option->{default}) if $option->{default};
-        return DevHelp::HTML::popup_menu(@args);
+        return BSE::Util::HTML::popup_menu(@args);
        }
        else {
         return escape_html($options[$option_index]{$_[0]})
index e8c0aeb..237007f 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use vars qw(@ISA);
 use Generate::Article;
 @ISA = qw(Generate::Article);
-use DevHelp::HTML;
+use BSE::Util::HTML;
 
 sub set_user {
   my ($self, $user) = @_;
index 6119d7c..324a0b9 100644 (file)
@@ -19,6 +19,24 @@ sub new {
   return bless \%opts, $class;
 }
 
+sub _slurp {
+  my ($self, $filename, $error) = @_;
+
+  my $opened = open my $fh, "<", $filename;
+  unless ($opened) {
+    $$error = "Cannot open $filename: $!";
+    return;
+  }
+  if ($self->{utf8}) {
+    my $charset = $self->{charset} || "utf-8";
+    binmode $fh, ":encoding($charset)";
+  }
+  my $data = do { local $/; <$fh> };
+  close $fh;
+
+  return $data;
+}
+
 sub low_perform {
   my ($self, $acts, $func, $args, $orig) = @_;
 
@@ -286,10 +304,9 @@ sub include {
 
   print STDERR "Found $filename\n" if DEBUG;
 
-  open INCLUDE, "< $filename"
-    or return "** cannot open $filename : $! **";
-  my $data = do { local $/; <INCLUDE> };
-  close INCLUDE;
+  my $error;
+  my $data = $self->_slurp($filename, \$error)
+    or return "* $error *";
   print STDERR "Included $filename >>$data<<\n"
       if DEBUG;
 
@@ -385,9 +402,8 @@ sub replace_template {
        last;
       }
       my $params = $3;
-      if (open WRAPPER, "< $wrapper") {
-        my $wraptext = do { local $/; <WRAPPER> };
-        close WRAPPER;
+      my $error;
+      if (my $wraptext = $self->_slurp($wrapper, \$error)) {
         $template = substr($template, length $1);
         $wraptext =~ s/<:\s*wrap\s+here\s*:>/$template/i
           and $template = $wraptext
@@ -417,7 +433,7 @@ sub replace_template {
        }
       }
       else {
-       print "ERROR: Unable to load wrapper $wrapper: $!\n";
+       print "ERROR: Unable to load wrapper $wrapper: $error\n";
       }
     }
   }
@@ -535,10 +551,9 @@ sub show_page {
     $file
       or die "Cannot find template $page";
   }
-  open TMPLT, "< $file"
+  my $error;
+  my $template = $self->_slurp($file, $error)
     or die "Cannot open template $file: $!";
-  my $template = do { local $/; <TMPLT> };
-  close TMPLT;
 
   my $result = $self->replace_template($template, $acts, $iter);
   print STDERR "<< show_page\n" if DEBUG;
index 36dc374..4828378 100644 (file)
@@ -65,9 +65,7 @@ sub generate_low {
   my $content = $gen->generate($article, $articles);
   my $tempname = $outname . ".work";
   unlink $tempname;
-  open OUT, "> $tempname" or die "Cannot create $tempname: $!";
-  print OUT $content or die "Cannot write content to $outname: $!";
-  close OUT or die "Cannot close $outname: $!";
+  _write_text($tempname, $content, $cfg);
   unlink $outname;
   rename($tempname, $outname)
     or die "Cannot rename $tempname to $outname: $!";
@@ -112,12 +110,7 @@ sub generate_search {
   my $tmpldir = $cfg->entryVar('paths', 'templates');
   my $outname = "$tmpldir/search.tmpl.work";
   my $finalname = "$tmpldir/search.tmpl";
-  open OUT, "> $outname"
-    or die "Cannot open $outname for write: $!";
-  print OUT $content
-    or die "Cannot write to $outname: $!";
-  close OUT
-    or die "Cannot close $outname: $!";
+  _write_text($outname, $content, $cfg);
   rename $outname, $finalname
     or die "Cannot rename $outname to $finalname: $!";
 }
@@ -156,12 +149,7 @@ sub generate_shop {
     my $tmpldir = $cfg->entryVar('paths', 'templates');
     my $outname = "$tmpldir/$name.tmpl.work";
     my $finalname = "$tmpldir/$name.tmpl";
-    open OUT, "> $outname"
-      or die "Cannot open $outname for write: $!";
-    print OUT $content
-      or die "Cannot write to $outname: $!";
-    close OUT
-      or die "Cannot close $outname: $!";
+    _write_text($outname, $content, $cfg);
     unlink $finalname;
     rename $outname, $finalname
       or die "Cannot rename $outname to $finalname: $!";
@@ -231,12 +219,7 @@ sub generate_extras {
       my $content = BSE::Template->get_page($input, $cfg, \%acts);
       my $finalname = $outpath . '/'. $out;
       my $outname = $finalname . '.work';
-      open OUT, "> $outname"
-       or die "Cannot open $outname for write: $!";
-      print OUT $content
-       or die "Cannot write content to $outname: $!";
-      close OUT
-       or die "Cannot close $outname: $!";
+      _write_text($outname, $content, $cfg);
       unlink $finalname;
       rename $outname, $finalname
        or die "Cannot rename $outname to $finalname: $!";
@@ -364,4 +347,19 @@ sub regen_and_refresh {
   return 1;
 }
 
+sub _write_text {
+  my ($filename, $data, $cfg) = @_;
+
+  open my $fh, ">", $filename
+    or die "Cannot create $filename: $!";
+  if ($cfg->utf8) {
+    my $charset = $cfg->charset;
+    binmode $fh,  ":encoding($charset)";
+  }
+  print $fh $data
+    or die "Cannot write $filename: $!";
+  close $fh
+    or die "Cannot close $filename: $!";
+}
+
 1;
index eb15c3f..48ecc59 100644 (file)
@@ -22,6 +22,15 @@ description: <<TEXT
 Message displayed when the username or password is invalid when logging in
 TEXT
 
+id: bse/user/dupaffiliatename
+description: Message displayed for a duplicate affiliate name
+
+id: bse/user/badaffiliatename
+description: Message displayed for an invalid affiliate name
+
+id: bse/user/optsrequired
+description: Message displayed for a required field during registration or when saving user details
+
 id: bse/admin/
 description: BSE Administration
 
diff --git a/site/docs/bse-unicode.pod b/site/docs/bse-unicode.pod
new file mode 100644 (file)
index 0000000..90dfe46
--- /dev/null
@@ -0,0 +1,104 @@
+=head1 NAME
+
+bse-unicode.pod - using unicode with BSE
+
+=head1 DESCRIPTION
+
+Using utf-8 with BSE is currently experimental.  This latest support
+is independent and incompatible with previous implementation changes.
+
+You will need to perform three steps:
+
+=over
+
+=item 1.
+
+change the database character set to utf-8
+
+=item 2.
+
+change the BSE character set to utf-8
+
+=item 3.
+
+enable the utf8 flag.
+
+=back
+
+=head2 Changing the database character set
+
+For a new system you can simply do:
+
+  cd util
+  perl upgrade_mysql.pl -c utf8
+
+For an old system it will be more complex.
+
+If the character set the database uses for your tables matches the
+character set of the data you already have stored, then the above will
+work.
+
+To check the character set:
+
+  mysql -uuser -p databasename
+  mysql> show full columns from order_item;
+
+If the C<Collation> column is a collation for your character set the
+the above will work.
+
+Note that Mysql's C<latin1> is equivalent to C<windows-1252>.
+
+If your database character set isn't equivalent you can fix the table
+character sets by converting to binary and then to the correct
+character set:
+
+  perl upgrade_mysql.pl -c binary
+  perl upgrade_mysql.pl -c latin1
+
+Only then perform the conversion to C<utf8>.
+
+=head2 Changing the BSE character set to UTF-8
+
+As you did historically, set C<charset> in C<html>:
+
+  [html]
+  charset=utf-8
+
+=head2 Enable the C<utf8> flag
+
+Set C<utf8=1> in C<[basic]>:
+
+  [basic]
+  utf8=1
+
+Note that this flag doesn't require that the BSE character set be set
+to utf-8, but it is recommended.
+
+The flag currently causes the following changes in behaviour:
+
+=over
+
+=item *
+
+template files are converted from the BSE character set to unicode for
+internal processing.
+
+=item *
+
+if the BSE character set is utf-8 then the database handle is
+configured to work in unicode.
+
+=item *
+
+template processed output is converted from unicode to the BSE
+character set on output.
+
+=item *
+
+JSON output is explicitly converted to UTF-8.
+
+=back
+
+BSE character set refers to the value configured in [html].charset
+
+=cut
index ad9e301..d23f5ba 100644 (file)
@@ -34,7 +34,7 @@ C<r> is to be used to accept refresh to URLs.
 
 =head2 CGI/URL encoding/generation
 
-Use the functions in DevHelp::HTML instead of the functions from CGI.
+Use the functions in BSE::Util::HTML instead of the functions from CGI.
 
 =head2 Refreshing
 
index 573f47d..369a8b1 100644 (file)
@@ -770,7 +770,7 @@ var BSEAPI = Class.create
           // just plain data
           state.req_data += "--" + state.sep;
           state.req_data += "Content-Disposition: form-data; name=\"" + entry[0] + "\"\r\n\r\n";
-          state.req_data += entry[1] + "\r\n";
+          state.req_data += this._encode_utf8(entry[1]) + "\r\n";
           ++state.index;
         }
        }
index 1477db4..dfe0def 100644 (file)
@@ -1,8 +1,10 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="<:cfg html charset iso8859-1:>"?>
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" >  
-<html><head><title>BSE - <:param title:></title>
-<link rel="stylesheet" href="/css/admin.css" />
+<html xmlns="http://www.w3.org/1999/xhtml">
+  <head>
+    <title>BSE - <:param title:></title>
+    <link rel="stylesheet" href="/css/admin.css" />
 <:ifParam css:><link rel="stylesheet" href="/css/<:param css:>" /><:or:><:eif:>
 <:ajax includes:>
 <script type="text/javascript" src="/js/bse.js"></script>
 <:ifParam api:><script type="text/javascript" src="/js/bse_api.js"></script><:or:><:eif:>
 <:ifParam jstools:><script type="text/javascript" src="/js/admin_tools.js"></script><:or:><:eif:>
 <:ifParam js:><script type="text/javascript" src="/js/<:param js:>"></script><:or:><:eif:>
-</head>
-<body>
+  </head>
+  <body>
 <:ifParam showtitle:><h1><:param title:></h1><:or:><:eif:>
 <:wrap here:>
-<hr />
-<p class="version">BSE Release <:release:> - page generated <:today:></p>
-</body></html>
+  <hr />
+  <p class="version">BSE Release <:release:> - page generated <:today:></p>
+  </body>
+</html>
index d8854aa..5ab6091 100644 (file)
@@ -16,7 +16,7 @@
         <b>Keywords: </b></font></td>
       <td width="10">&nbsp;&nbsp; </td>
       <td width="100%"> 
-        <input type="text" name="q" id="q" size="45" value="<:terms:>">
+        <input type="text" name="q" id="qx" size="45" value="<:terms:>">
         &nbsp; 
         <input type="submit" id="search_submit" accesskey="s" value="Search" name="submit">
       </td>
@@ -54,7 +54,7 @@
 <script type="text/javascript" language="javascript">
 //<![CDATA[
 function do_search() {
-  var query = $('q').value;
+  var query = $('qx').value;
   if (query != 'Enter search terms' && query != '') {
     $('search_form').request({
       parameters: { embed: '1'},
@@ -65,20 +65,23 @@ function do_search() {
   }
   return false;
 }
-new Form.Observer($('search_form'), 1.5, do_search);
-$('search_submit').onclick = do_search;
-$('q').onfocus =
-  function() {
-    if ($('q').value == 'Enter search terms') {
-      $('q').value = '';
-    };
-  }
-$('q').onblur =
-  function() {
-    if ($('q').value == '') {
-      $('q').value = 'Enter search terms';
-    };
-  }
+  function on_load_search() {
+    new Form.Observer($('search_form'), 1.5, do_search);
+    $('search_submit').onclick = do_search;
+    $('qx').onfocus =
+      function() {
+        if ($('q').value == 'Enter search terms') {
+          $('q').value = '';
+        };
+      }
+    $('qx').onblur =
+      function() {
+        if ($('qx').value == '') {
+          $('qx').value = 'Enter search terms';
+        };
+      }
+    }
+Event.observe(document, "dom:loaded", on_load_search);
 //]]>
 </script>
 <:or Ajax:><:eif Ajax:>
index 453a315..618c250 100644 (file)
@@ -477,7 +477,7 @@ Column articleId;int(11);NO;NULL;
 Column summary;varchar(255);NO;NULL;
 Column leadTime;int(11);NO;0;
 Column retailPrice;int(11);NO;NULL;
-Column wholesalePrice;int(11);YES;NULL;
+Column wholesalePrice;int(11);NO;NULL;
 Column gst;int(11);NO;NULL;
 Column options;varchar(255);NO;NULL;
 Column subscription_id;int(11);NO;-1;
@@ -498,7 +498,7 @@ Column scores;varchar(255);NO;;
 Index PRIMARY;1;[id]
 Table sessions
 Column id;char(32);NO;NULL;
-Column a_session;text;YES;NULL;
+Column a_session;blob;YES;NULL;
 Column whenChanged;timestamp;NO;CURRENT_TIMESTAMP;
 Index PRIMARY;1;[id]
 Table site_users