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
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
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
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
-- prices are in cents
retailPrice integer not null,
- wholesalePrice integer,
+ wholesalePrice integer not null,
-- amount of GST on this item
gst integer not null,
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 {
[thumb geometries]
editor=scale(200x200)
sadmingall=scale(120x120),dropshadow(),canvas(140x140,bgalpha:0),format(png)
+search=scale(150x120)
[file handlers]
flv=BSE::FileHandler::FLV
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 =
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);
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;
package BSE::Arrows;
use strict;
-use DevHelp::HTML;
+use BSE::Util::HTML;
use base 'Exporter';
--- /dev/null
+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
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 =
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
{
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 {
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};
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;
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";
}
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;
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";
}
(
$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
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';
}
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;
$@
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;
package BSE::Edit::Catalog;
use strict;
use base 'BSE::Edit::Article';
-use DevHelp::HTML;
+use BSE::Util::HTML;
sub base_template_dirs {
return ( "catalog" );
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);
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 {
package BSE::FileHandler::Default;
use strict;
use base "BSE::FileHandler::Base";
-use DevHelp::HTML;
+use BSE::Util::HTML;
sub process_file {
my ($self, $file) = @_;
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) = @_;
package BSE::Formatter;
use strict;
-use DevHelp::HTML;
+use BSE::Util::HTML;
use Carp 'confess';
use base 'DevHelp::Formatter';
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 {
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;
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/;
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';
$self->{cache}->set("msg-$key", $entry);
}
+ $msg or return;
+
# clone so the caller doesn't modify cached value
my %entry = %$msg;
return \%entry;
use strict;
use CGI ();
use BSE::Cfg;
-use DevHelp::HTML;
+use BSE::Util::HTML;
use Carp qw(cluck confess);
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 {
&& $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
$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;
}
print STDERR "CGI ERROR: $error\n";
}
+ if ($self->utf8) {
+ require BSE::CGI;
+ return BSE::CGI->new($q, $self->charset);
+ }
+
return $q;
}
my $userid = $session->{userid}
or return;
- my $user = SiteUsers->getBy(userId=>$userid)
+ my $user = SiteUsers->getByPkey($userid)
or return;
$user->{disabled}
and return;
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) {
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.
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)
$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;
}
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
package BSE::TagFormats;
use strict;
-use DevHelp::HTML;
+use BSE::Util::HTML;
sub _format_image {
my ($self, $im, $align, $rest) = @_;
package BSE::Template;
use strict;
use Squirrel::Template;
-use Carp 'confess';
+use Carp qw(confess cluck);
use Config ();
sub templater {
$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";
}
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});
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;
}
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}) {
package BSE::ThumbLow;
use strict;
-use DevHelp::HTML;
sub _thumbimage_low {
my ($self, $geo_id, $im, $field, $cfg, $static) = @_;
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';
use base 'BSE::UI::AdminDispatch';
use BSE::Util::Tags;
use BSE::Report;
-use DevHelp::HTML;
+use BSE::Util::HTML;
my %actions =
(
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);
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);
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 =
(
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;
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;
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
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);
(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";
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
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";
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";
use strict;
use base qw(BSE::UI::Dispatch);
use Digest::MD5 qw(md5_hex);
-use DevHelp::HTML;
+use BSE::Util::HTML;
my %actions =
(
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;
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) .
"&s=" . escape_uri($section) .
"&d=" . escape_uri($date) .
- "&page=".$page_num_iter;
+ "&page=".$page_num_iter .
+ "&pp=$results_per_page";
},
highlight_result =>
[ \&tag_highlight_result, \$current_result, $cfg, $words_re ],
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);
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;
package BSE::UI::SiteuserCommon;
use strict;
-use DevHelp::HTML;
+use BSE::Util::HTML;
use BSE::Util::Tags qw(tag_hash);
use constant MAXWIDTH => 10000;
use BSE::Template;
use BSE::Util::Iterate;
use BSE::TB::Subscriptions;
-use DevHelp::HTML;
+use BSE::Util::HTML;
my %rights =
(
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);
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;
message => sub { CGI::escapeHTML($message) },
);
- BSE::Template->show_page('user/logon', $cfg, \%acts);
- return;
+ return $req->response('user/logon', \%acts);
}
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;
);
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;
$user->{password} eq $password
or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
-
+
return $user;
}
else {
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;
}
}
}
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;
);
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 {
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);
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;
$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);
$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} }
'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 {
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+$/) {
);
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 {
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"));
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,
$message ||= $cgi->param('message') || '';
$message = escape_html($message);
- my $userid = $session->{userid};
- my $user;
- if ($userid) {
- $user = SiteUsers->getBy(userId=>$userid);
- }
my %acts;
%acts =
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;
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);
--- /dev/null
+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
package BSE::Util::Iterate;
use strict;
use base 'DevHelp::Tags::Iterate';
-use DevHelp::HTML;
+use BSE::Util::HTML;
use Carp 'confess';
sub escape {
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);
sub escape_html {
my ($text, $what) = @_;
- $what ||= '<>&"\x7F-\xFF';
+ $what ||= '<>&"\x7F';
HTML::Entities::encode($text, $what);
}
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;
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;
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 {
);
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]})
use vars qw(@ISA);
use Generate::Article;
@ISA = qw(Generate::Article);
-use DevHelp::HTML;
+use BSE::Util::HTML;
sub set_user {
my ($self, $user) = @_;
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) = @_;
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;
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
}
}
else {
- print "ERROR: Unable to load wrapper $wrapper: $!\n";
+ print "ERROR: Unable to load wrapper $wrapper: $error\n";
}
}
}
$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;
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: $!";
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: $!";
}
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: $!";
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: $!";
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;
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
--- /dev/null
+=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
=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
// 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;
}
}
-<?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>
<b>Keywords: </b></font></td>
<td width="10"> </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:>">
<input type="submit" id="search_submit" accesskey="s" value="Search" name="submit">
</td>
<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'},
}
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:>
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;
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
projects / bse.git / commitdiff