-MANIFEST.bak
-test.cfg
-INSTALL.html
-INSTALL.txt
-site/cgi-bin/modules/BSE/Modules.pm
-site/cgi-bin/modules/BSE/Version.pm
+/MANIFEST.bak
+/test.cfg
+/install.cfg
+/INSTALL.html
+/INSTALL.txt
+/site/cgi-bin/modules/BSE/Modules.pm
+/site/cgi-bin/modules/BSE/Version.pm
.#*
*~
/cover_db
+/bse-[0-9]*
\ No newline at end of file
Artistic
Changes.txt
COPYING
+install.cfg
INSTALL.html
INSTALL.pod
INSTALL.txt
+lib/BSE/Install.pm
localinst.perl # simple test installer
Makefile
makehtmldocs.pl
^\.git/
^test\.cfg$
^test-.*cfg$
+^install\.cfg$
^nswfitc\.cfg$
^site/htdocs/images/admin/help\.png$
^install.perl$
POD2TEXT=$(PERLBIN)/pod2text
POD2HTML=$(PERLBIN)/pod2html
+UTILDIR=$(shell $(PERL) -Ilib -MBSE::Install=util_dir -e 'print util_dir')
+DATADIR=$(shell $(PERL) -Ilib -MBSE::Install=data_dir -e 'print data_dir')
+
.PHONY: help dist cleantree archive distdir clean docs otherdocs dbinfo
.PHONY: version modversion testinst test testup checkver regen_known_errors
.PHONY: manicheck filecheck manifect htmldocs
testinst: distdir
$(PERL) localinst.perl $(DISTBUILD)
$(PERL) -MExtUtils::Command -e rm_rf $(DISTBUILD)
- cd `$(PERL) -lne 'do { print $$1; exit; } if /^base_dir\s*=\s*(.*)/' test.cfg`/util ; $(PERL) loaddata.pl ../data/db
+ cd $(UTILDIR) ; $(PERL) loaddata.pl $(DATADIR)/db
testup: checkver distdir
$(PERL) localinst.perl $(DISTBUILD) leavedb
$(PERL) -MExtUtils::Command -e rm_rf $(DISTBUILD)
- cd `$(PERL) -lne 'do { print $$1; exit; } if /^base_dir\s*=\s*(.*)/' test.cfg`/util ; $(PERL) upgrade_mysql.pl -b ; $(PERL) loaddata.pl ../data/db
+ cd $(UTILDIR) ; $(PERL) upgrade_mysql.pl -b ; $(PERL) loaddata.pl $(DATADIR)/db
checkver:
if [ -d .git ] ; then perl site/util/check_versions.pl ; fi
--- /dev/null
+[paths]
+siteroot=FIXME
+
+[site]
+secureadmin=1
+url=FIXME
+secret=FIXME
+secureurl=FIXME
+
+[db]
+dsn=dbi:mysql:FIXME
+user=FIXME
+password=FIXME
+class=BSE::DB::Mysql
+
+[basic]
+access_control=0
+ajax=1
+utf8=1
+
+[html]
+charset=utf-8
+
+[editor]
+thumbs_class=BSE::Thumb::Imager
+allow_thumb=1
+check_modified=1
+
+
+[shop]
+to_email=FIXME
+from=FIXME
--- /dev/null
+package BSE::Install;
+use strict;
+use Exporter 'import';
+our @EXPORT_OK = qw(cfg util_dir cgi_dir public_html_dir templates_dir data_dir mysql_name perl);
+use lib 'site/cgi-bin/modules';
+use BSE::Cfg;
+
+our $VERSION = "1.000";
+
+my $conffile = $ENV{BSECONFIG} || 'install.cfg';
+
+my $cfg = BSE::Cfg->new
+ (
+ path => "site/cgi-bin",
+ extra_file => $conffile,
+ );
+
+sub cfg {
+ $cfg;
+}
+
+sub conffile {
+ $conffile;
+}
+
+sub util_dir {
+ $cfg->entryVar("paths", "util");
+}
+
+sub cgi_dir {
+ $cfg->entryVar("paths", "cgi-bin");
+}
+
+sub public_html_dir {
+ $cfg->entryVar("paths", "public_html");
+}
+
+sub templates_dir {
+ $cfg->entryVar("paths", "templates");
+}
+
+sub data_dir {
+ $cfg->entryVar("paths", "data");
+}
+
+sub mysql_name {
+ $cfg->entry("binaries", "mysql", "mysql");
+}
+
+sub perl {
+ $cfg->entry("paths", "perl", $^X);
+}
+
+sub db_dsn {
+ $cfg->entryErr("db", "dsn");
+}
+
+sub db_user {
+ $cfg->entryErr("db", "user");
+}
+
+sub db_password {
+ $cfg->entryErr("db", "password");
+}
+
+1;
use strict;
#use File::Tree;
use File::Copy;
-use lib 't';
-use BSE::Test ();
-require ExtUtils::Manifest;
+use lib 'lib';
+use BSE::Install qw(util_dir cgi_dir public_html_dir templates_dir data_dir mysql_name);
+#use BSE::Test ();
+use ExtUtils::Manifest qw(maniread);
+use File::Copy qw(copy);
+use File::Spec;
+use File::Path qw(make_path);
+use Getopt::Long;
+
+my $verbose;
+GetOptions("v|verbose" => \$verbose);
my $dist = shift or die "Usage: $0 distdir [leavedb]";
my $leavedb = shift or 0;
-my $instbase = shift || BSE::Test::base_dir() || die "No base_dir";
-my $mysql = BSE::Test::mysql_name;
+my $mysql = mysql_name();
-# if (-e "$instbase/cgi-bin/modules/Constants.pm"
-# && !-e "$instbase/Constants.pm") {
-# system "cp $instbase/cgi-bin/modules/Constants.pm $instbase/Constants.pm"
-# }
+my $cfg = BSE::Install::cfg();
-#system("rm -rf $instbase/cgi-bin")
-# and die "Cannot remove cgi-bin";
-#system "rm -rf $instbase/data"
-# and die "Cannot remove data";
-#system "rm -f $instbase/htdocs/{*.html,a/*.html,shop/*.html,images/*.jpg}"
-# and die "Cannot remove htdocs";
+my $manifest = maniread();
--d "$instbase/cgi-bin" or mkdir "$instbase/cgi-bin"
- or die "Cannot create $instbase/cgi-bin: $!";
-system "cp -rf $dist/site/cgi-bin/* $instbase/cgi-bin"
- and die "Cannot copy cgi-bin";
+install_files("site/htdocs/", public_html_dir());
+install_files("site/templates/", templates_dir());
+install_files("site/cgi-bin", cgi_dir());
+install_files("site/util/", util_dir());
+install_files("site/data/", data_dir());
-my $perl = BSE::Test::test_perl();
+my $perl = BSE::Install::perl();
if ($perl ne '/usr/bin/perl') {
my $manifest = ExtUtils::Manifest::maniread();
for my $file (keys %$manifest) {
- (my $work = $file) =~ s!^site!!;
- my $full = $instbase . $work;
+ (my $work = $file) =~ s!^site/!!;
+ $work =~ s(^(cgi-bin|util)/)()
+ or next;
+ my $base = $work eq "util" ? util_dir() : cgi_dir();
+ my $full = File::Spec->catfile($base, $work);
open my $script, "<", $full
or next;
binmode $script;
}
}
-system "cp -rf $dist/site/htdocs/* $instbase/htdocs"
- and die "Cannot copy htdocs";
-system "cp -rf $dist/site/templates/* $instbase/templates"
- and die "Cannot copy templates";
-system "cp -rf $dist/site/data $instbase"
- and die "Cannot copy data";
-system "cp -rf $dist/site/util/ $instbase";
-
print "Updating conf\n";
-# try to update Constants.pm
-open CON, "< $instbase/cgi-bin/modules/Constants.pm"
- or die "Cannot open Constants.pm";
-my $con = do { local $/; <CON> };
-close CON;
-
-my $dbuser = BSE::Test::test_dbuser();
-my $dbpass = BSE::Test::test_dbpass();
-
-#$con =~ s/(^\$DSN = ')[^']*/$1 . BSE::Test::test_dsn()/me;
-#$con =~ s/(^\$DBCLASS = ')[^']*/$1 . BSE::Test::test_dbclass()/me;
-#$con =~ s/(^\$UN = ')[^']*/$1$dbuser/m;
-#$con =~ s/(^\$PW = ')[^']*/$1$dbpass/m;
-#$con =~ s/(^\$BASEDIR = ')[^']+/$1 . BSE::Test::base_dir/me;
-#$con =~ s/(^\$URLBASE = ["'])[^'"]+/$1 . BSE::Test::base_url/me;
-#$con =~ s/(^\$SECURLBASE = ["'])[^'"]+/$1 . BSE::Test::test_securl/me;
-$con =~ s/(^\$SESSION_CLASS = [\"\'])[^\'\"]+/$1 . BSE::Test::test_sessionclass()/me;
-open CON, "> $instbase/cgi-bin/modules/Constants.pm"
- or die "Cannot open Constants.pm for write: $!";
-print CON $con;
-close CON;
-
-
-# rebuild the config file
-# first load values from the test.cfg file
-my $conffile = BSE::Test::test_conffile();
-my %conf;
-$conf{site}{url} = BSE::Test::base_url();
-$conf{site}{secureurl} = BSE::Test::base_securl();
-$conf{paths}{siteroot} = $instbase;
-#my $uploads = "$instbase/uploads";
-#$conf{paths}{downloads} = $uploads;
-#my $templates = "$instbase/templates";
-#$conf{paths}{templates} = $templates;
-#$conf{paths}{public_html} = "$instbase/htdocs";
-open TESTCONF, "< $conffile"
- or die "Could not open config file $conffile: $!";
-while (<TESTCONF>) {
- chomp;
- /^\s*(\w[^=]*\w)\.([\w-]+)\s*=\s*(.*)\s*$/ or next;
- $conf{lc $1}{$2} = $3;
-}
-
-#$uploads = $conf{paths}{downloads};
-# create installation config
-$conf{db}{class} = BSE::Test::test_dbclass();
-$conf{db}{dsn} = BSE::Test::test_dsn();
-$conf{db}{user} = $dbuser;
-$conf{db}{password} = $dbpass;
-
-open CFG, "> $instbase/cgi-bin/bse-install.cfg"
- or die "Cannot create $instbase/cgi-bin/bse-install.cfg: $!";
-
-print CFG "; DO NOT EDIT - created during installation\n";
-for my $section_name (keys %conf) {
- print CFG "[$section_name]\n";
- my $section = $conf{$section_name};
- for my $key (keys %$section) {
- print CFG "$key=$section->{$key}\n";
- }
- print CFG "\n";
-}
-
-close CFG;
+my $conf_src = BSE::Install::conffile();
+my $conf_dest = File::Spec->catfile(cgi_dir(), "bse-install.cfg");
+copy($conf_src, $conf_dest)
+ or die "Cannot copy $conf_src to $conf_dest: $!\n";
#-d $uploads
# or mkdir $uploads, 0777
# or die "Cannot find or create upload directory: $!";
+my $dbuser = BSE::Install::db_user();
+my $dbpass = BSE::Install::db_password();
# build the database
-my $dsn = BSE::Test::test_dsn();
+my $dsn = BSE::Install::db_dsn();
if ($dsn =~ /:mysql:(?:database=)?(\w+)/) {
my $db = $1;
unless ($leavedb) {
system "$mysql -u$dbuser -p$dbpass $db <$dist/schema/bse.sql"
and die "Cannot initialize database";
- system "cd $instbase/util ; $perl initial.pl"
+ system "cd ".util_dir." ; $perl initial.pl"
and die "Cannot load database";
}
print "WARNING: cannot install to $dsn database\n";
}
-
+sub install_files {
+ my ($prefix, $destbase) = @_;
+
+ print "Install $prefix to $destbase\n";
+ for my $file (sort grep /^\Q$prefix/, keys %$manifest) {
+ (my $rel = $file) =~ s/^\Q$prefix//;
+ my $src = File::Spec->catfile($dist, $file);
+ my $dest = File::Spec->catfile($destbase, $rel);
+ my ($destvol, $destdir) = File::Spec->splitpath($dest);
+ my $destpath = File::Spec->catdir($destvol, $destdir);
+ unless (-e $destpath) {
+ make_path($destpath); # croak on error
+ }
+ elsif (!-d $destpath) {
+ die "$destpath isn't a directory!\n";
+ }
+ print " Copy $rel to $dest\n" if $verbose;
+ copy($src, $dest)
+ or die "Cannot copy $src to $dest: $!\n";
+ }
+}
images=$(public_html)/managed_assets
data=$(siteroot)/data
templates=$(siteroot)/templates
+cgi-bin=$(siteroot)/cgi-bin
+util=$(siteroot)/util
[uri]
images=/managed_assets
use BSE::DB;
use BSE::CfgInfo qw/custom_class/;
-our $VERSION = "1.001";
+our $VERSION = "1.002";
sub _session_require {
my ($cfg) = @_;
sub _session_class {
my ($cfg) = @_;
- eval { require Constants; };
-
- my $default = $Constants::SESSION_CLASS || 'Apache::Session::MySQL';
-
- return $cfg->entry('basic', 'session_class', $default);
+ return $cfg->entry('basic', 'session_class', "Apache::Session::MySQL");
}
sub _send_session_cookie {
#!perl -w
use strict;
-use BSE::Test qw(base_url make_ua skip check_form post_ok ok
+use Test::More tests => 22;
+use BSE::Test qw(base_url make_ua check_form post_ok
check_content follow_ok);
use URI::QueryParam;
#use WWW::Mechanize;
++$|;
-print "1..22\n";
my $baseurl = base_url;
my $ua = make_ua;
ok($us_medium_cost_sea, "got a US medium cost");
like($us_medium_cost_sea, qr/^\d+$/, "it's an integer");
print "# $us_medium_cost_sea\n";
-cmp_ok($perth_medium_cost, "<=", $us_medium_cost_sea, "perth <= us sea");
+cmp_ok($perth_medium_cost, "<=", $us_medium_cost_air, "perth <= us air");
# too big
my $too_long = BSE::Shipping::Parcel->new
#!perl -w
use strict;
-use BSE::Test qw(ok);
use File::Find;
+use Test::More;
my @files;
open MANIFEST, "< MANIFEST" or die "Cannot open MANIFEST";
}
close MANIFEST;
my @scripts = grep /\.(pl|t)$/, @files;
-print "1..",scalar(@files) + scalar(@scripts),"\n";
+plan tests => scalar(@files) + scalar(@scripts);
for my $file (@files) {
open SRC, "< $file" or die "Cannot open $file: $!";
my $data = do { local $/; <SRC> };
package BSE::Test;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK);
-@ISA = qw(Exporter);
-require 'Exporter.pm';
-@EXPORT = qw(base_url ok fetch_ok make_url skip make_ua);
-@EXPORT_OK = qw(base_url ok make_ua fetch_url fetch_ok make_url skip
+use Exporter 'import';
+@EXPORT = qw(base_url fetch_ok make_url skip make_ua);
+@EXPORT_OK = qw(base_url make_ua fetch_url fetch_ok make_url skip
make_post check_form post_ok check_content follow_ok
follow_refresh_ok click_ok config test_actions);
+use lib 'site/cgi-bin/modules';
+use BSE::Cfg;
-my %conf;
+my $conffile = $ENV{BSETEST} || 'install.cfg';
-my $conffile = $ENV{BSETEST} || 'test.cfg';
+my $cfg = BSE::Cfg->new
+ (
+ path => "site/cgi-bin",
+ extra_file => $conffile,
+ );
-open TESTCFG, "< $conffile" or die "Cannot open $conffile: $!";
-while (<TESTCFG>) {
- next if /^\s*[\#;]/;
- chomp;
- next unless /^\s*(\w+)\s*=\s*(.*)/
- or /^\s*(\w[^=]*\w\.\w+)\s*=\s*(.*\S)\s*$/;
- $conf{$1} = $2;
+sub config {
+ $cfg;
}
-close TESTCFG;
-
-sub base_url { $conf{base_url} or die "No base_url in test config" }
-sub base_securl {
- $conf{securl} or $conf{base_url} or die "No securl or base_url in $conffile"
+sub base_url {
+ $cfg->entryVar("site", "url");
}
-sub base_dir { $conf{base_dir} or die "No base_dir in test config" }
-
-sub mysql_name { $conf{mysql} or die "No mysql in test config" }
-
-sub test_dsn { $conf{dsn} or die "No dsn in test config" }
-
-sub test_dbuser { $conf{dbuser} or die "No dbuser in test config" }
-
-sub test_dbpass { $conf{dbpass} or die "No dbpass in test config" }
-
-sub test_dbclass { $conf{dbclass} or die "No dbclass in test config" }
+sub base_securl {
+ $cfg->entryVar("site", "secureurl");
+}
-sub test_sessionclass { $conf{sessionclass} or die "No sessionclass in config" }
-sub test_perl { $conf{perl} or "/usr/bin/perl" }
+sub base_dir {
+ $cfg->entryVar("paths", "siteroot");
+}
-sub test_conffile {
- return $conffile;
+sub mysql_name {
+ $cfg->entry("binaries", "mysql", "mysql");
}
-sub config {
- my ($name) = @_;
+sub test_dsn {
+ $cfg->entry("db", "dsn");
+}
- $conf{$name};
+sub test_dbuser {
+ $cfg->entry("db", "user");
}
-my $test_num = 1;
+sub test_dbpass {
+ $cfg->entry("db", "password");
+}
-sub ok ($$) {
- my ($ok, $desc) = @_;
+sub test_dbclass {
+ $cfg->entry("db", "class", "BSE::DB::Mysql");
+}
- if ($INC{"Test/More.pm"}) {
- return Test::More::ok($ok, $desc);
- }
- else {
- if ($ok) {
- print "ok $test_num # $desc\n";
- }
- else {
- print "not ok $test_num # $desc ",join(",", caller()),"\n";
- }
- ++$test_num;
- return $ok;
- }
+sub test_sessionclass {
+ $cfg->entry("basic", "session_class", "Apache::Session::Mysql");
}
-sub skip {
- my ($desc, $count) = @_;
+sub test_perl {
+ $cfg->entry("paths", "perl", $^X);
+}
- if ($INC{"Test/More.pm"}) {
- SKIP: {
- Test::More::skip($desc, $count);
- }
- }
- else {
- $count ||= 1;
- for my $i (1..$count) {
- print "ok $test_num # skipped: $desc\n";
- ++$test_num;
- }
- }
+sub test_conffile {
+ $conffile;
}
sub make_ua {
sub check_content {
my ($content, $note, $match) = @_;
- unless (ok($content =~ /$match/s, "$note: match")) {
- print "# wanted /$match/ got:\n";
- my $copy = $content;
- $copy =~ s/^/# /gm;
- $copy .= "\n" unless $copy =~ /\n\z/;
- print $copy;
- }
+ my $tb = Test::Builder->new;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ return $tb->like($content, qr/$match/s, "$note: match");
}
sub _check_fetch {
my ($content, $code, $ok, $headers,
$note, $match, $headmatch) = @_;
+ my $tb = Test::Builder->new;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
my $good = $ok;
- ok($ok, "$note: fetch ($code)");
- if ($ok) {
+ $tb->ok($ok, "$note: fetch ($code)");
+ SKIP:
+ {
+ my $count = 0;
+ $count++ if $match;
+ $count++ if $headmatch;
+ $ok or skip("$note: fetch failed", $count) if $count;
if ($match) {
- unless (ok($content =~ /$match/s, "$note: match")) {
- print "# wanted /$match/ got:\n";
- my $copy = $content;
- $copy =~ s/^/# /gm;
- $copy .= "\n" unless $copy =~ /\n\z/;
- print $copy;
+ unless ($tb->like($content, qr/$match/s, "$note: match")) {
+ #print "# wanted /$match/ got:\n";
+ #my $copy = $content;
+ #$copy =~ s/^/# /gm;
+ #$copy .= "\n" unless $copy =~ /\n\z/;
+ #print $copy;
$good = 0;
}
}
if ($headmatch) {
- unless (ok($headers =~ /$headmatch/s, "$note: headmatch")) {
- print "# wanted /$headmatch/ got:\n";
- my $copy = $headers;
- $copy =~ s/^/# /gm;
- $copy .= "\n" unless $copy =~ /\n\z/;
- print $copy;
+ unless ($tb->like($headers, qr/$headmatch/s, "$note: headmatch")) {
+ #print "# wanted /$headmatch/ got:\n";
+ #my $copy = $headers;
+ #$copy =~ s/^/# /gm;
+ #$copy .= "\n" unless $copy =~ /\n\z/;
+ #print $copy;
$good = 0;
}
}
}
- else {
- my $count = 0;
- $count++ if $match;
- $count++ if $headmatch;
- skip("$note: fetch failed", $count) if $count;
- }
if (wantarray) {
return ($content, $code, $good, $headers);
sub click_ok {
my ($ua, $note, $name, $match, $headmatch) = @_;
- my $ok = ok($ua->click($name), "$note - click");
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my $tb = Test::Builder->new;
+
+ my $ok = $tb->ok($ua->click($name), "$note - click");
return _check_fetch($ua->{content}, $ua->{status}, $ok,
$ua->{res}->headers_as_string, $note,
$match, $headmatch)
my $textname;
my %values;
+ my $tb = Test::Builder->new;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
my $text =
sub {
my ($t) = @_;
if ($tagname eq 'input') {
my $name = $attr->{name};
if ($name && $todo{$name}) {
- ok(1, "$note - $name - field is present");
+ $tb->ok(1, "$note - $name - field is present");
$values{$name} = $attr->{$name};
if (defined $todo{$name}[0]) {
my $cvalue = $checks{$name}[0];
my $fvalue = $attr->{value};
if (defined $fvalue) {
- ok($cvalue eq $fvalue, "$note - $name - comparing values");
+ $tb->ok($cvalue eq $fvalue, "$note - $name - comparing values");
}
else {
- ok(0, "$note - $name - value is not present");
+ $tb->ok(0, "$note - $name - value is not present");
}
}
if (defined $todo{$name}[1]) {
my $ttype = $todo{$name}[1];
my $ftype = $attr->{type};
if (defined $ftype) {
- ok($ttype eq $ftype, "$note - $name - comparing types");
+ $tb->ok($ttype eq $ftype, "$note - $name - comparing types");
}
else {
- ok(0, "$note - $name - type not present");
+ $tb->ok(0, "$note - $name - type not present");
}
}
delete $todo{$name};
$selname = $attr->{name};
if ($todo{$selname}) {
- ok(1, "$note - $selname - field is present");
+ $tb->ok(1, "$note - $selname - field is present");
$inselect = 1;
if (defined $todo{$selname}[1]) {
$checked_sel_value = 0;
my $ttype = $todo{$selname}[1];
- ok ($ttype eq 'select', "$note - $selname - checking type (select)");
+ $tb->ok ($ttype eq 'select', "$note - $selname - checking type (select)");
}
}
}
my $fvalue = $attr->{value};
my $tvalue = $todo{$selname}[0];
if (defined $fvalue) {
- ok($fvalue eq $tvalue, "$note - $selname - checking value ($fvalue vs $tvalue)");
+ $tb->ok($fvalue eq $tvalue, "$note - $selname - checking value ($fvalue vs $tvalue)");
}
else {
- ok(0, "$note - $selname - no value supplied");
+ $tb->ok(0, "$note - $selname - no value supplied");
}
}
}
if ($tagname eq 'select' && $inselect) {
if (!$checked_sel_value) {
- ok(0, "$note - $selname - no value selected");
+ $tb->ok(0, "$note - $selname - no value selected");
}
delete $todo{$selname};
}
if ($todo{$textname}) {
my $fvalue = HTML::Entities::decode_entities($saved);
$values{$textname} = $fvalue;
- ok(1, "$note - $textname - field exists");
+ $tb->ok(1, "$note - $textname - field exists");
if (defined $todo{$textname}[0]) {
my $tvalue = $todo{$textname}[0];
- ok($tvalue eq $fvalue, "$note - $textname - checking value($tvalue vs $fvalue)");
+ $tb->ok($tvalue eq $fvalue, "$note - $textname - checking value($tvalue vs $fvalue)");
}
if (defined $todo{$textname}[1]) {
- ok ($todo{$textname}[1] eq 'textarea',
+ $tb->ok ($todo{$textname}[1] eq 'textarea',
"$note - $textname - check field type");
}
delete $todo{$textname};
$p->parse($content);
$p->eof;
for my $name (keys %todo) {
- ok(0, "$note - $name - field doesn't exist");
+ $tb->ok(0, "$note - $name - field doesn't exist");
my $count = 0;
++$count if defined $todo{$name}[0];
++$count if defined $todo{$name}[1];
- skip("$note - $name - no field", $count);
+ SKIP: {
+ skip("$note - $name - no field", $count) if $count;
+ }
}
return %values;
my ($class) = @_;
my $tb = Test::Builder->new;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
my $obj = $class->new;
my $actions = $obj->actions;
#!perl -w
use strict;
-use BSE::Test qw(make_ua ok fetch_ok base_url config);
+use Test::More tests => 62;
+use BSE::Test qw(make_ua fetch_ok base_url config);
++$|;
-print "1..62\n";
my $baseurl = base_url;
ok($baseurl =~ /^http:/, "basic check of base url");
my $ua = make_ua;
"No\\s+documents\\s+were\\s+found");
fetch_ok($ua, "good search", "$baseurl/cgi-bin/search.pl?q=shop",
qr!You\s+can\s+buy!s);
-if (config('site users.nopassword')) {
+if (config->entry('site users', 'nopassword')) {
fetch_ok($ua, "not user logon page", "$baseurl/cgi-bin/user.pl",
qr!Not\s+Authenticated!s);
}
projects / bse.git / commitdiff