-VERSION=0.15_02
+VERSION=0.15_03
DISTNAME=bse-$(VERSION)
DISTBUILD=$(DISTNAME)
DISTTAR=../$(DISTNAME).tar
# make sure everything is committed
cleantree:
+ if grep -q 'perl.*-d:ptkdb' site/cgi-bin/*.pl site/cgi-bin/admin/*.pl ; \
+ then echo '***' The debugger is still enabled ; \
+ exit 1; \
+ fi
if cvs status 2>/dev/null | grep -q '^\?\|Locally Modified' ; \
then echo '***' The tree has modified or unadded files ; \
exit 1 ; \
-- represents sections, articles
DROP TABLE IF EXISTS article;
CREATE TABLE article (
- id integer DEFAULT '0' NOT NULL auto_increment,
+ id integer NOT NULL auto_increment,
-- 0 for the entry page
-- -1 for top-level sections (shown in side menu)
DROP TABLE IF EXISTS searchindex;
CREATE TABLE searchindex (
- id varchar(200) binary DEFAULT '' NOT NULL,
+ id varbinary(200) DEFAULT '' NOT NULL,
-- a comma-separated lists of article and section ids
articleIds varchar(255) default '' not null,
sectionIds varchar(255) default '' not null,
undef $tl;
my @expected = qw(field type null key default extra);
-my @want = qw(field type null default extra);
+my @want = qw(field type null default extra);
for my $table (@tables) {
print "Table $table\n";
my $ti = $dbh->prepare("describe $table")
while (my $row = $ti->fetchrow_arrayref) {
for my $name (@want) {
defined $row->[$names{$name}] or $row->[$names{$name}] = "NULL";
+ if ($name eq 'type' &&
+ $row->[$names{$name}] =~ /^varchar\((\d+)\) binary$/i) {
+ $row->[$names{$name}] = "varbinary($1)";
+ }
}
print "Column ",join(";",@$row[@names{@want}]),
"\n";
use Carp 'verbose';
use BSE::Request;
use URI::Escape;
+use BSE::CfgInfo 'admin_base_url';
my $req = BSE::Request->new;
my $cfg = $req->cfg;
my $cgi = $req->cgi;
-my $siteurl = $cfg->entryErr('site', 'url');
+my $siteurl = admin_base_url($cfg);
unless ($req->check_admin_logon()) {
refresh_to_admin($cfg, "/cgi-bin/admin/logon.pl");
exit;
my $type = $cgi->param('type');
if ($type) {
- @kids = grep { $_->[0]{generator} =~ /::\Q$type\E$/, @kids;
+ @kids = grep $_->[0]{generator} =~ /::\Q$type\E$/, @kids;
}
my @order = sort { $b <=> $a } map $_->[1]{$_->[2]}, @kids;
-#!/usr/bin/perl -w -d:ptkdb
+#!/usr/bin/perl -w
+# -d:ptkdb
BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0' }
use strict;
use FindBin;
sub tag_old {
my ($cgi, $args, $acts, $name, $templater) = @_;
- my ($field, $func, $funcargs) =
- DevHelp::Tags->get_parms($args, $acts, $templater);
+ my ($field, $func, $funcargs);
+
+ if ($args =~ /^(\[[^\[\]]*(?:\[[^\[\]]*\][^\[\]]*)*\])(.*)/) {
+ my ($fieldargs, $rest) = ($1, $2);
+ ($field) = DevHelp::Tags->get_parms($fieldargs, $acts, $templater);
+ defined $rest or $rest = '';
+ ($func, $funcargs) = split ' ', $rest, 2;
+ }
+ else {
+ ($field, $func, $funcargs) = split ' ', $args, 3;
+ }
my $value = $cgi->param($field);
if (defined $value) {
oldi => [ \&tag_oldi, $cgi ],
$it->make_iterator(\&DevHelp::Tags::iter_get_repeat, 'repeat', 'repeats'),
dynreplace => \&tag_replace,
+ dyntoday => \&tag_today,
);
}
shift @points if @points and $points[0] eq '';
return '' unless @points;
for my $point (@points) {
- $point =~ s!\n$!<br /><br />!;
+ $point =~ s!\n$!!
+ and $point = "<p>$point</p>";
}
return "<ul><li>".join("</li><li>", @points)."</li></ul>";
}
shift @points if @points and $points[0] eq '';
return '' unless @points;
for my $point (@points) {
- $point =~ s!\n$!<br /><br />!;
+ $point =~ s!\n$!!
+ and $point = "<p>$point</p>";
}
my $ol = "<ol";
$ol .= qq! type="$type"! if $type;
sub replace_char {
my ($self, $rpart) = @_;
-
- $$rpart =~ s#poplink\[([^|\]\[]+)\|([^\]\[]+)\]#<a href="$1" target="_blank">$2</a>#ig
+ $$rpart =~ s#(acronym|abbr|dfn)\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#
+ _fix_spanned(qq/<$1 class="$3" title="$2">/, "</$1>", $4)#egi
and return 1;
- $$rpart =~ s#poplink\[([^|\]\[]+)\]#<a href="$1" target="_blank">$1</a>#ig
+ $$rpart =~ s#(acronym|abbr|dfn)\[([^|\]\[]+)\|([^\]\[]+)\]#
+ _fix_spanned(qq/<$1 title="$2">/, "</$1>", $3)#egi
and return 1;
- $$rpart =~ s#link\[([^|\]\[]+)\|([^\]\[]+)\]#<a href="$1">$2</a>#ig
+ $$rpart =~ s#(acronym|abbr|dfn)\[\|([^\]\[]+)\]#
+ _fix_spanned("<$1>", "</$1>", $2)#egi
and return 1;
- $$rpart =~ s#link\[([^|\]\[]+)\]#<a href="$1">$1</a>#ig
+ $$rpart =~ s#(acronym|abbr|dfn)\[([^\]\[]+)\]#
+ _fix_spanned("<$1>", "</$1>", $2)#egi
+ and return 1;
+ $$rpart =~ s#bdo\[([^|\]\[]+)\|([^\]\[]+)\]#
+ _fix_spanned(qq/<bdo dir="$1">/, "</bdo>", $2)#egi
+ and return 1;
+ $$rpart =~ s#(strong|em|samp|code|var|sub|sup|kbd|q|b|i|tt)\[([^|\]\[]+)\|([^\]\[]+)\]#
+ _fix_spanned(qq/<$1 class="$2">/, "</$1>", $3)#egi
and return 1;
- $$rpart =~ s#b\[([^\]\[]+)\]#_fix_spanned("<b>", "</b>", $1)#egi
+ $$rpart =~ s#(strong|em|samp|code|var|sub|sup|kbd|q|b|i|tt)\[\|([^\]\[]+)\]#
+ _fix_spanned("<$1>", "</$1>", $2)#egi
and return 1;
- $$rpart =~ s#i\[([^\]\[]+)\]#_fix_spanned("<i>", "</i>", $1)#egi
+ $$rpart =~ s#(strong|em|samp|code|var|sub|sup|kbd|q|b|i|tt)\[([^\]\[]+)\]#
+ _fix_spanned("<$1>", "</$1>", $2)#egi
and return 1;
- $$rpart =~ s#tt\[([^\]\[]+)\]#_fix_spanned("<tt>", "</tt>", $1)#egi
+ $$rpart =~ s#poplink\[([^|\]\[]+)\|([^\]\[]+)\]#
+ _fix_spanned(qq/<a href="$1" target="_blank">/, "</a>", $2)#eig
+ and return 1;
+ $$rpart =~ s#poplink\[([^|\]\[]+)\]#<a href="$1" target="_blank">$1</a>#ig
+ and return 1;
+ $$rpart =~ s#link\[([^|\]\[]+)\|([^\]\[]+)\]#
+ _fix_spanned(qq/<a href="$1">/, "</a>", $2)#eig
+ and return 1;
+ $$rpart =~ s#link\[([^|\]\[]+)\]#<a href="$1">$1</a>#ig
and return 1;
$$rpart =~ s#font\[([^|\]\[]+)\|([^\]\[]+)\]#
_fix_spanned(qq/<font size="$1">/, "</font>", $2)#egi
- and return 1;
+ and return 1;
$$rpart =~ s#anchor\[([^|\]\[]*)\]#<a name="$1"></a>#ig
and return 1;
$$rpart =~ s#fontcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#
_fix_spanned(qq/<font size="$1" color="$2">/, "</font>", $3)#egi
- and return 1;
+ and return 1;
$$rpart =~ s!(?<=\W)\[([^\]\[]+)\]![$1]!g
and return 1;
$out .= "<pre>$work</pre>";
}
else {
+ next unless $part =~ /\S/;
TRY: while (1) {
$self->replace(\$part)
and next TRY;
and next TRY;
$part =~ s#pre\[([^\]\[]+)\]#<pre>$1</pre>#ig
and next TRY;
- $part =~ s#h([1-6])\[\|([^\[\]]+)\](?:\r?\n)?#<h$1>$2</h$1>#ig
- and next TRY;
- $part =~ s#div\[([^\[\]\|]+)\|([^\[\]]+)\]#<div class="$1">$2</div>#ig
- and next TRY;
- $part =~ s#h([1-6])\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#<h$1 class="$2">$3</h$1>#ig
- and next TRY;
+ $part =~ s#h([1-6])\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#
+ _fix_spanned(qq/\n\n<h$1 class="$2">/, "</h$1>\n\n", $3)#ieg
+ and next TRY;
+ $part =~ s#\n*h([1-6])\[\|([^\[\]]+)\]\n*#
+ _fix_spanned("\n\n<h$1>", "</h$1>\n\n", $2)#ieg
+ and next TRY;
+ $part =~ s#\n*h([1-6])\[([^\[\]]+)\]\n*#
+ _fix_spanned("\n\n<h$1>", "</h$1>\n\n", $2)#ieg
+ and next TRY;
$part =~ s#align\[([^|\]\[]+)\|([^\]\[]+)\]#<div align="$1">$2</div>#ig
and next TRY;
$part =~ s#hr\[([^|\]\[]*)\|([^\]\[]*)\]#_make_hr($1, $2)#ieg
and next TRY;
$part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_make_table($1, "|$2")#ieg
and next TRY;
- $part =~ s#(?:^|\n{1,2})((?: *(?:\*\*|\#\#|\%\%)[^\n]+(?:\n|$)\n?[^\S\n]*)+)\n?#_format_lists($1)#eg
+ #print STDERR "step: ",unpack("H*", $part),"\n$part\n";
+ $part =~ s#(?:^|\n+|\G)((?: *(?:\*\*|\#\#|\%\%)[^\n]+(?:\n|$)\n?[^\S\n]*)+)\n?#"\n\n"._format_lists($1)."\n\n"#eg
and next TRY;
$part =~ s#indent\[([^\]\[]+)\]#<ul>$1</ul>#ig
and next TRY;
and next TRY;
$part =~ s#class\[([^\]\[\|]+)\|([^\]\[]+)\]#
_fix_spanned(qq/<span class="$1">/, "</span>", $2)#eig
- and next TRY;
+ and next TRY;
$part =~ s#style\[([^\]\[\|]+)\|([^\]\[]+)\]#
_fix_spanned(qq/<span style="$1">/, "</span>", $2)#eig
- and next TRY;
+ and next TRY;
+ $part =~ s#(div|address|blockquote)\[\n*([^\[\]\|]+)\|\n*([^\[\]]+?)\n*\]#<$1 class="$2">$3</$1>#ig
+ and next TRY;
+ $part =~ s#(div|address|blockquote)\[\n*\|([^\[\]]+?)\n*]#<$1>$2</$1>#ig
+ and next TRY;
+ $part =~ s#(div|address|blockquote)\[\n*([^\[\]]+?)\n*]#<$1>$2</$1>#ig
+ and next TRY;
last;
}
+ $part =~ s/^\s+|\s+\z//g; # avoid spurious leading/trailing <p>
$part =~ s!(\n([ \r]*\n)*)!$1 eq "\n" ? "<br />\n" : "</p>\n<p>"!eg;
$part = "<p>$part</p>";
- $part =~ s/<p>
<div class=\"([^\"]+)\">/<div class="$1"><p>/g;
+ $part =~ s/<p>
(<div [^>]*>)/$1<p>/g;
$part =~ s!</div></p>!</p></div>!g;
+ $part =~ s/<p>(<blockquote>)/$1<p>/g;
+ $part =~ s/<p>(<blockquote [^>]*>)/$1<p>/g;
+ $part =~ s!</blockquote></p>!</p></blockquote>!g;
+ $part =~ s/<p>(<address>)/$1<p>/g;
+ $part =~ s/<p>(<address [^>]*>)/$1<p>/g;
+ $part =~ s!</address></p>!</p></address>!g;
+ $part =~ s!<p>(<hr[^>]*>)</p>!$1!g;
+ $part =~ s!<p>(<(?:table|ol|ul|center|h[1-6])[^>]*>)!$1!g;
+ $part =~ s!(</(?:table|ol|ul|center|h[1-6])>)</p>!$1!g;
+ # attempts to convert class[name|paragraph] into <p class="name">...
+ # tried to use a negative lookahead but it wouldn't work
+ $part =~ s#(<p><span class="([^"<>]+)">(.*?)</span></p>)#
+ my ($one, $two, $three)= ($1, $2, $3);
+ $3 =~ /<span/ ? $one : qq!<p class="$two">$three</p>!#ge;
+ $part =~ s#(<p><span style="([^"<>]+)">(.*?)</span></p>)#
+ my ($one, $two, $three)= ($1, $2, $3);
+ $3 =~ /<span/ ? $one : qq!<p style="$two">$three</p>!#ge;
#$part =~ s!\n!<br />!g;
$out .= $part;
}
TRY: while (1) {
$self->remove(\$part)
and next TRY;
+ $part =~ s#(?:acronym|abbr|dfn)\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#$3#ig
+ and next TRY;
+ $part =~ s#(?:acronym|abbr|dfn|bdo)\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
+ and next TRY;
+ $part =~ s#(?:acronym|abbr|dfn|bdo)\[(\|[^|\]\[]+)\]#$1#ig
+ and next TRY;
+ $part =~ s#(?:acronym|abbr|dfn)\[([^|\]\[]+)\]#$1#ig
+ and next TRY;
+ $part =~ s#(?:strong|em|samp|code|var|sub|sup|kbd|q|address|blockquote|b|i|tt)\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
+ and next TRY;
+ $part =~ s#(?:strong|em|samp|code|var|sub|sup|kbd|q|address|blockquote|b|i|tt)\[\|([^\]\[]+)\]#$1#ig
+ and next TRY;
+ $part =~ s#(?:strong|em|samp|code|var|sub|sup|kbd|q|address|blockquote|b|i|tt)\[([^\]\[]+)\]#$1#ig
+ and next TRY;
$part =~ s#div\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#$2#ig
- and next TRY;
- $part =~ s#h([1-6])\[\|([^\[\]]+)\](?:\r?\n)?#$2#ig
- and next TRY;
+ and next TRY;
$part =~ s#h([1-6])\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#$3#ig
- and next TRY;
+ and next TRY;
+ $part =~ s#h([1-6])\[\|([^\[\]]+)\](?:\r?\n)?#$2#ig
+ and next TRY;
+ $part =~ s#h([1-6])\[([^\[\]]+)\](?:\r?\n)?#$2#ig
+ and next TRY;
$part =~ s#poplink\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
and next TRY;
$part =~ s#poplink\[([^|\]\[]+)\]#$1#ig
and next TRY;
$part =~ s#link\[([^|\]\[]+)\]#$1#ig
and next TRY;
- $part =~ s#[bi]\[([^\]\[]+)\]#$1#ig
- and next TRY;
- $part =~ s#tt\[([^\]\[]+)\]#$1#ig
- and next TRY;
$part =~ s#align\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
and next TRY;
$part =~ s#font\[([^|\]\[]+)\|([^\]\[]+)\]#$2#ig
$part =~ s#image\[([^\]\[]+)\]##ig
and next TRY;
$part =~ s#class\[([^\]\[\|]+)\|([^\]\[]+)\]#$2#ig
- and next TRY;
+ and next TRY;
$part =~ s#style\[([^\]\[\|]+)\|([^\]\[]+)\]#$2#ig
- and next TRY;
+ and next TRY;
last TRY;
}
exists $opts{'-name'}
or confess "No -name parameter";
- my $html = '<select name="' . escape_html($opts{"-name"}) . '">';
+ 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"};
$text .= '...';
}
- return $self->format_body({}, $articles, $text, 'tr', 1, 0);
+ # the formatter now adds <p></p> around the text, but we don't
+ # want that here
+ my $result = $self->format_body({}, $articles, $text, 'tr', 1, 0);
+ $result =~ s!<p>|</p>!!g;
+
+ return $result;
}
# attempts to move the given position forward if it's within a HTML tag,
return 0;
},
level2 => sub {
- return $subsections[$subsect_index]{$_[0]};
+ return escape_html($subsections[$subsect_index]{$_[0]});
},
ifLevel2 =>
sub {
use BSE::Cfg;
use BSE::Template;
use DevHelp::HTML qw':default popup_menu';
+use BSE::Util::Tags;
my $cfg = BSE::Cfg->new;
my %acts;
%acts =
(
+ BSE::Util::Tags->basic(\%acts, $cgi, $cfg),
iterate_results =>
sub {
++$result_seq;
multiple => sub { @results != 1 },
terms => sub { escape_html($words) },
resultSeq => sub { $result_seq },
- list => sub { popup_menu(-name=>'s',
+ list => sub { popup_menu(-name=>'s', -id => 's',
-values=>\@sections,
-labels=>\%sections) },
=head1 CHANGES
+=head2 0.15_03
+
+=over
+
+=item *
+
+generate.pl would refresh to the wrong place when secure admin was
+configured, causing the logon page to be displayed.
+
+=item *
+
+reorder.pl had a syntax error which didn't show in the test suite.
+The test suite has been updated to catch similar errors in reorder.pl
+
+=item *
+
+the low level body text formatter now includes <p></p> around its
+results. Many other minor changes were made to hopefully improve the
+output from the formatter.
+
+=item *
+
+the level2 tag now HTML escapes its results
+
+=item *
+
+the old tag is now more backward compatible.
+
+=item *
+
+changed the search index primary key from "varchar(200) binary" to
+"varbinary(200)". Unfortunately mysql 3 reports this type as
+"varchar(200) binary" so the tool we use to build mysql.str has been
+mangled to convert that type to varbinary.
+
+=item *
+
+the article table included a default value declaration in the column
+spec for the primary key. This conflicts with the auto_increment on
+mysql 4 and has been removed.
+
+=item *
+
+the makefile now checks for .pl files that still include the option to
+start the debugger in their #! lines before building a dist. This
+will prevent releasing a dist that tries to start the debugger when
+you call a script.
+
+=item *
+
+the search results page now has access to the basic dynamic tags
+
+=back
+
=head2 0.15_02
=over
use BSE::Test qw(make_ua ok fetch_ok base_url config);
++$|;
-print "1..55\n";
+print "1..58\n";
my $baseurl = base_url;
ok($baseurl =~ /^http:/, "basic check of base url");
my $ua = make_ua;
qr!Invalid\s+template\s+name!i);
fetch_ok($ua, "siteusers", "$baseurl/cgi-bin/admin/siteusers.pl",
qr!Admin Site Members!i);
+
+fetch_ok($ua, "reorder", "$baseurl/cgi-bin/admin/reorder.pl",
+ "html", "Refresh: 0; .*/menu\.pl");
#!perl -w
use strict;
-use Test::More tests => 46;
+use Test::More tests => 62;
sub format_test($$$;$);
SKIP: {
skip "couldn't load module", 41 unless $gotmodule;
+ format_test 'acronym[hello]', '<p><acronym>hello</acronym></p>', 'acronym';
+ format_test 'acronym[|hello]', '<p><acronym>hello</acronym></p>', 'acronym with empty title';
+ format_test 'acronym[foo|hello]', '<p><acronym title="foo">hello</acronym></p>', 'acronym with title';
+ format_test 'acronym[foo|bar|hello]', '<p><acronym class="bar" title="foo">hello</acronym></p>', 'acronym with class and title';
+ format_test 'bdo[ltr|hello]', '<p><bdo dir="ltr">hello</bdo></p>', 'bdo with dir';
+ format_test 'code[hello]', '<p><code>hello</code></p>', 'code';
+ format_test 'code[|hello]', '<p><code>hello</code></p>', 'code empty class';
+ format_test 'code[foo|hello]', '<p><code class="foo">hello</code></p>', 'code with class';
+ format_test 'code[var[x]="1"]', '<p><code><var>x</var>="1"</code></p>', 'code with var';
+ format_test 'blockquote[hello]', '<blockquote><p>hello</p></blockquote>', 'blockquote';
+ format_test 'blockquote[|hello]', '<blockquote><p>hello</p></blockquote>', 'blockquote with empty class';
+ format_test 'blockquote[foo|hello]', '<blockquote class="foo"><p>hello</p></blockquote>', 'blockquote with class';
+ format_test <<IN, <<OUT, 'strong over paras', 'both';
+strong[foo|hello
+foo]
+IN
+<p><strong class="foo">hello</strong></p>
+<p><strong class="foo">foo</strong></p>
+OUT
+ format_test <<IN, <<OUT, 'blockquote list h1 var', 'both';
+blockquote[
+** one
+** two
+h1[quux]var[hello
+there]
+
+foo]
+IN
+<blockquote><ul><li>one</li><li>two</li></ul>
+<h1>quux</h1>
+<p><var>hello<br />
+there</var></p>
+<p>foo</p></blockquote>
+OUT
+ format_test <<IN, <<OUT, 'address class h1 abbr over paras', 'both';
+address[foo|h1[bar
+
+quux]abbr[my abbr|hello]
+
+class[foo|b[bold|E=MCsup[2]]]
+
+foo]
+IN
+<address class="foo"><h1>bar</h1>
+<h1>quux</h1>
+<p><abbr title="my abbr">hello</abbr></p>
+<p class="foo"><b class="bold">E=MC<sup>2</sup></b></p>
+<p>foo</p></address>
+OUT
+ format_test <<IN, <<OUT, 'div blockquote h1 class over paras', 'both';
+div[quux|blockquote[foo|h1[bar]
+b[hello]
+class[foo|b[bold|E=MCsup[2
+
+kbd[xxx|super]]]]
+
+foo]]
+IN
+<div class="quux"><blockquote class="foo"><h1>bar</h1>
+<p><b>hello</b><br />
+<span class="foo"><b class="bold">E=MC<sup>2</sup></b></span></p>
+<p class="foo"><b class="bold"><sup><kbd class="xxx">super</kbd></sup></b></p>
+<p>foo</p></blockquote></div>
+OUT
format_test <<IN, <<OUT, 'bold', 'both';
b[hello]
IN
<p><i><b>bar</b></i></p>
OUT
format_test <<IN, <<OUT, 'link', 'both';
-link[http://foo/|bar]
+link[http://foo/|bar
+
+quux]
IN
<p><a href="http://foo/">bar</a></p>
+<p><a href="http://foo/">quux</a></p>
OUT
format_test 'tt[hello]', '<p><tt>hello</tt></p>', 'tt';
format_test 'font[-1|text]', '<p><font size="-1">text</font></p>', 'fontsize';
test formmail validation.company_description=Organization
test formmail validation.company_required=0
+site.secureadmin=1
projects / bse.git / commitdiff