site/cgi-bin/modules/BSE/TB/OrderItem.pm
site/cgi-bin/modules/BSE/TB/OrderItems.pm
site/cgi-bin/modules/BSE/TB/Seminar.pm
+site/cgi-bin/modules/BSE/TB/SeminarSession.pm
+site/cgi-bin/modules/BSE/TB/SeminarSessions.pm
site/cgi-bin/modules/BSE/TB/Seminars.pm
site/cgi-bin/modules/BSE/TB/Subscription.pm
site/cgi-bin/modules/BSE/TB/Subscription/Calc.pm
site/templates/admin/edit_catalog.tmpl
site/templates/admin/edit_product.tmpl
site/templates/admin/edit_seminar.tmpl
+site/templates/admin/edit_semsessions.tmpl
+site/templates/admin/edit_semsessadd.tmpl
site/templates/admin/edit_steps.tmpl
site/templates/admin/filelist.tmpl
site/templates/admin/grouplist.tmpl
site/templates/admin/reports/list.tmpl
site/templates/admin/reports/prompt.tmpl
site/templates/admin/reports/show1.tmpl
+site/templates/admin/semsessiondel.tmpl
+site/templates/admin/semsessionedit.tmpl
+site/templates/admin/semsessionrollcall.tmpl
site/templates/admin/showgroup.tmpl
site/templates/admin/showgroupart.tmpl
site/templates/admin/showgroup_del.tmpl
site/templates/user/options_images_base.tmpl
site/templates/user/options_saved_base.tmpl
site/templates/user/register_base.tmpl
+site/templates/user/sessiondeletenotify.tmpl
site/templates/user/subdetail.tmpl
site/templates/user/toosoon_base.tmpl
site/templates/user/toomany_base.tmpl
t/BSE/Test.pm
t/t00smoke.t makes a request to most of the scripts
t/t010template.t Tests Squirrel::Template
+t/t011dhdates.t Tests DevHelp::Date
t/t050format.t DevHelp::Formatter tests
t/t060parms.t
t/t070sqldates.t Test SQL date tools
-VERSION=0.15_13
+VERSION=0.15_14
DISTNAME=bse-$(VERSION)
DISTBUILD=$(DISTNAME)
DISTTAR=../$(DISTNAME).tar
seminar_id integer not null,
location_id integer not null,
when_at datetime not null,
+ roll_taken integer not null default 0,
primary key (id),
unique (seminar_id, location_id, when_at),
index (location_id)
);
+drop table if exists bse_seminar_bookings;
+create table bse_seminar_bookings (
+ session_id integer not null,
+ siteuser_id integer not null,
+ roll_present integer not null default 0,
+
+ primary key(session_id, siteuser_id),
+ index (siteuser_id)
+);
my $products = Products->new;
my @list;
if ($session->{showstepkids}) {
- @list = grep $_->{generator} eq 'Generate::Product', $catalog->allkids;
+ my @allkids = $catalog->allkids;
+ my %allgen = map { $_->{generator} => 1 } @allkids;
+ for my $gen (keys %allgen) {
+ (my $file = $gen . ".pm") =~ s!::!/!g;
+ require $file;
+ }
+ @list = grep UNIVERSAL::isa($_->{generator}, 'Generate::Product'), $catalog->allkids;
@list = map { $products->getByPkey($_->{id}) } @list;
}
else {
from article ar, product pr, bse_seminars se
where id = ? and ar.id = pr.articleId and ar.id = se.seminar_id
SQL
+
+ seminarSessionInfo => <<SQL,
+select se.*, lo.description
+ from bse_seminar_sessions se, bse_locations lo
+ where se.seminar_id = ? and se.location_id = lo.id
+order by when_at desc
+SQL
+ addSeminarSession => 'insert bse_seminar_sessions values(null,?,?,?,?)',
+ replaceSeminarSession => 'replace bse_seminar_sessions values(?,?,?,?,?)',
+ deleteSeminarSession => 'delete from bse_seminar_sessions where id = ?',
+ getSeminarSessionByPkey => 'select * from bse_seminar_sessions where id = ?',
+ getSeminarSessionByLocation_idAndWhen_at => <<SQL,
+select * from bse_seminar_sessions
+ where location_id = ? and when_at = ?
+SQL
+ 'SeminarSessions.futureSessions' => <<SQL,
+select * from bse_seminar_sessions
+ where seminar_id = ? and when_at >= ?
+SQL
+ 'SiteUsers.sessionBookings' => <<SQL,
+select su.* from site_users su, bse_seminar_bookings sb
+ where sb.session_id = ? and su.id = sb.siteuser_id
+SQL
+ cancelSeminarSessionBookings => <<SQL,
+delete from bse_seminar_bookings where session_id = ?
+SQL
+ conflictSeminarSessions => <<SQL,
+select bo1.siteuser_id
+ from bse_seminar_bookings bo1, bse_seminar_bookings bo2
+where bo1.session_id = ? and bo2.session_id = ?
+ and bo1.siteuser_id = bo2.siteuser_id
+SQL
+ seminarSessionBookedIds => <<SQL,
+select * from bse_seminar_bookings where session_id = ?
+SQL
+ seminarSessionBookUser => <<SQL,
+insert bse_seminar_bookings values(?,?)
+SQL
+ seminarSessionRollCallEntries => <<SQL,
+select bo.roll_present, su.id, su.userId, su.name1, su.name2, su.email
+ from bse_seminar_bookings bo, site_users su
+where bo.session_id = ? and bo.siteuser_id = su.id
+SQL
+ updateSessionRollPresent => <<SQL
+update bse_seminar_bookings
+ set roll_present = ?
+ where session_id = ? and siteuser_id = ?
+SQL
);
sub _single
my $cgi = $request->cgi;
my $show_full = $cgi->param('f_showfull');
- $msg ||= $cgi->param('message');
+ $msg ||= join "\n", map escape_html($_), $cgi->param('message'), $cgi->param('m');
$msg ||= '';
$errors ||= {};
if (keys %$errors && !$msg) {
my ($self, $article, $cgi, $name, $message, $extras) = @_;
my $url = $cgi->param('r');
- unless ($url) {
+ if ($url) {
+ if ($url !~ /[?&](m|message)=/ && $message) {
+ # add in messages if none in the provided refresh
+ my @msgs = ref $message ? @$message : $message;
+ for my $msg (@msgs) {
+ $url .= "&m=" . CGI::escape($msg);
+ }
+ }
+ }
+ else {
my $urlbase = admin_base_url($self->{cfg});
$url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
- $url .= "&message=" . CGI::escape($message) if $message;
+ if ($message) {
+ my @msgs = ref $message ? @$message : $message;
+ for my $msg (@msgs) {
+ $url .= "&m=" . CGI::escape($msg);
+ }
+ }
if ($cgi->param('_t')) {
$url .= "&_t=".CGI::escape($cgi->param('_t'));
}
use base 'BSE::Edit::Product';
use BSE::TB::Seminars;
use BSE::Util::Tags qw(tag_hash tag_hash_mbcs);
+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);
+
+sub article_actions {
+ my ($self) = @_;
+
+ return
+ (
+ $self->SUPER::article_actions(),
+ a_addsemsession => 'req_addsemsession',
+ a_editsemsession => 'req_editsemsession',
+ a_savesemsession => 'req_savesemsession',
+ a_askdelsemsession => 'req_askdelsemsession',
+ a_delsemsession => 'req_delsemsession',
+ a_takesessionrole => 'req_takesessionrole',
+ a_takesessionrolesave => 'req_takesessionrolesave',
+ );
+}
sub base_template_dirs {
return ( "seminar" );
my $cfg = $req->cfg;
my $mbcs = $cfg->entry('html', 'mbcs', 0);
my $tag_hash = $mbcs ? \&tag_hash_mbcs : \&tag_hash;
+ my $cur_session;
my $it = BSE::Util::Iterate->new;
return
(
seminar => [ $tag_hash, $article ],
$self->SUPER::low_edit_tags($acts, $req, $article, $articles, $msg,
$errors),
+ $it->make_iterator
+ ([ \&iter_sessions, $article, $req ], 'session', 'sessions',
+ undef, undef, undef, \$cur_session),
+ $it->make_iterator
+ ([ \&iter_locations, $article ], 'location', 'locations'),
+ ifSessionRemovable => [ \&tag_ifSessionRemovable, \$cur_session ],
);
}
+sub tag_ifSessionRemovable {
+ my ($rcur_session) = @_;
+
+ $$rcur_session or return 0;
+
+ $$rcur_session->{when_at} gt now_sqldatetime();
+}
+
+sub iter_sessions {
+ my ($seminar, $req, $args) = @_;
+
+ my $which = $args || $req->cgi->param('s') || '';
+
+ $seminar->{id} or return;
+
+ my @sessions = $seminar->session_info;
+
+ # synthesize the past entry
+ my $sql_now = now_sqldatetime();
+ for my $session (@sessions) {
+ $session->{past} = $session->{when_at} lt $sql_now ? 1 : 0;
+ }
+
+ if ($which ne 'all') {
+ @sessions = grep !$_->{past}, @sessions;
+ }
+
+ @sessions;
+}
+
+sub iter_locations {
+ my ($seminar, $req, $args) = @_;
+
+ $args ||= '';
+
+ require BSE::TB::Locations;
+ my @locations = BSE::TB::Locations->all;
+ unless ($args eq 'all') {
+ @locations = grep !$_->{disabled}, @locations;
+ }
+
+ @locations;
+}
+
sub get_article {
my ($self, $articles, $article) = @_;
return $self->SUPER::_validate_common($data, $articles, $errors);
}
+my %session_fields =
+ (
+ location_id => { description => "Location",
+ rules=>"required;positiveint" },
+ when_at_date => { description => "Date",
+ rules => "required;futuredate" },
+ when_at_time => { description => "Time",
+ rules => "required;time" },
+ );
+
+sub req_addsemsession {
+ my ($self, $req, $article, $articles) = @_;
+
+ my $cgi = $req->cgi;
+
+ my %fields = %session_fields;
+ my %errors;
+ $req->validate(errors=>\%errors,
+ fields=>\%fields,
+ section=>SECT_SEMSESSION_VALIDATION);
+ my $location_id;
+ my $location;
+ unless ($errors{location_id}) {
+ require BSE::TB::Locations;
+
+ $location_id = $cgi->param('location_id');
+ $location = BSE::TB::Locations->getByPkey($location_id)
+ or $errors{location_id} = "Unknown location";
+ }
+ my $when;
+ unless (keys %errors) {
+ require BSE::TB::SeminarSessions;
+ my $date = dh_parse_date_sql($cgi->param('when_at_date'));
+ my $time = dh_parse_time_sql($cgi->param('when_at_time'));
+ $when = "$date $time";
+
+ my ($existing) = BSE::TB::SeminarSessions->getBy(location_id=>$location_id,
+ when_at=>$when);
+ if ($existing) {
+ $errors{location_id} = $errors{when_at_date} =
+ $errors{when_at_time} = "A session is already booked for that date and time at this location";
+ }
+ }
+ keys %errors
+ and return $self->edit_form($req, $article, $articles, undef, \%errors);
+
+ my $session = $article->add_session($when, $location);
+
+ return $self->refresh($article, $cgi, undef, 'Session added');
+}
+
+sub _get_session {
+ my ($req, $article, $rmsg) = @_;
+
+ my $cgi = $req->cgi;
+ my $session_id = $cgi->param('session_id');
+ defined $session_id && $session_id =~ /^\d+$/
+ or do { $$rmsg = "Missing or invalid session id"; return; };
+ require BSE::TB::SeminarSessions;
+ my $session = BSE::TB::SeminarSessions->getByPkey($session_id)
+ or do { $$rmsg = "Unknown session $session_id"; return; };
+ $session->{seminar_id} == $article->{id}
+ or do { $$rmsg = "Session does not belong to this seminar"; return };
+
+ return $session;
+}
+
+sub req_editsemsession {
+ my ($self, $req, $article, $articles, $errors) = @_;
+
+ my $cgi = $req->cgi;
+ my $msg;
+ my $session = _get_session($req, $article, \$msg)
+ or return $self->edit_form($req, $article, $articles, $msg);
+
+ my %fields = %session_fields;
+ my $cfg_fields = $req->configure_fields(\%fields, SECT_SEMSESSION_VALIDATION);
+
+ my %acts;
+ %acts =
+ (
+ $self->low_edit_tags(\%acts, $req, $article, undef, $errors),
+ field => [ \&tag_field, $cfg_fields ],
+ session => [ \&tag_hash, $session ],
+ );
+
+ return $req->dyn_response('admin/semsessionedit.tmpl', \%acts);
+}
+
+sub req_savesemsession {
+ my ($self, $req, $article, $articles) = @_;
+
+ my $cgi = $req->cgi;
+ my $msg;
+ my $session = _get_session($req, $article, \$msg)
+ or return edit_form($req, $article, $articles, $msg);
+
+ my %fields = %session_fields;
+ my %errors;
+ $req->validate(errors=>\%errors,
+ fields=>\%fields,
+ section=>SECT_SEMSESSION_VALIDATION);
+ my $location_id;
+ my $location;
+ unless ($errors{location_id}) {
+ require BSE::TB::Locations;
+
+ $location_id = $cgi->param('location_id');
+ $location = BSE::TB::Locations->getByPkey($location_id)
+ or $errors{location_id} = "Unknown location";
+ }
+ my $when;
+ unless (keys %errors) {
+ require BSE::TB::SeminarSessions;
+ my $date = dh_parse_date_sql($cgi->param('when_at_date'));
+ my $time = dh_parse_time_sql($cgi->param('when_at_time'));
+ $when = "$date $time";
+
+ my ($existing) = BSE::TB::SeminarSessions->getBy(location_id=>$location_id,
+ when_at=>$when);
+ if ($existing && $existing->{session_id} != $session->{session_id}) {
+ $errors{location_id} = $errors{when_at_date} =
+ $errors{when_at_time} = "A session is already booked for that date and time at this location";
+ }
+ }
+ keys %errors
+ and return $self->edit_form($req, $article, $articles, undef, \%errors);
+
+ my $old_location_id = $session->{location_id};
+ my $old_when = $session->{when_at};
+ $session->{location_id} = $location_id;
+ $session->{when_at} = $when;
+ $session->save;
+
+ my @msgs = 'Seminar session saved';
+
+ if ($cgi->param('notify')
+ && ($session->{location_id} != $old_location_id
+ || $session->{when_at} ne $old_when)) {
+ my $old_location = BSE::TB::Locations->getByPkey($old_location_id);
+ my @bookings = $session->booked_users();
+ my $notify_sect = 'Session Change Notification';
+ require BSE::Mail;
+ my $cfg = $req->cfg;
+ my $mailer = BSE::Mail->new(cfg=>$cfg);
+ my $from = $cfg->entry($notify_sect, 'from',
+ $cfg->entry('shop', 'from', $Constants::SHOP_FROM));
+ my @errors;
+ my $sent;
+ for my $user (@bookings) {
+ my %acts;
+ %acts =
+ (
+ session => [ \&tag_hash_plain, $session ],
+ seminar => [ \&tag_hash_plain, $article ],
+ old_when => $old_when,
+ old_location => [ \&tag_hash_plain, $old_location ],
+ location => [ \&tag_hash_plain, $location ],
+ );
+
+ if ($mailer->complex_mail(from=>$from,
+ to=>$user->{email},
+ template=>'user/sessionchangenotify',
+ acts=>\%acts,
+ section=>$notify_sect,
+ subject=>'Session Rescheduled')) {
+ ++$sent;
+ }
+ else {
+ push @errors, "Error sending notification to $user->{email}:"
+ . $mailer->errstr;
+ }
+ }
+
+ if (@bookings) {
+ if ($sent) {
+ $msgs[0] .= " ($sent users notified by email about the change)";
+ if (@errors > 5) {
+ # something really wrong, dump them to the error log and trim the list
+ print STDERR $_ for @errors;
+ my $total = @errors;
+ splice @errors, 5;
+ push @errors, "(more errors omitted - total of $total errors)";
+ }
+ push @msgs, @errors;
+ }
+ }
+ else {
+ $msgs[0] .= ' (No users were booked for this session to be notified)';
+ }
+ }
+
+ return $self->refresh($article, $cgi, undef, \@msgs);
+}
+
+sub iter_other_sessions {
+ my ($seminar, $session) = @_;
+
+ grep $_->{id} != $session->{id}, $seminar->future_sessions;
+}
+
+sub tag_other_location {
+ my ($rcur_session, $arg) = @_;
+
+ $$rcur_session or return '';
+ my $location = $$rcur_session->location;
+
+ my $value = $location->{$arg};
+ defined $value or return '';
+
+ escape_html($value);
+}
+
+sub req_askdelsemsession {
+ my ($self, $req, $article, $articles, $errors) = @_;
+
+ my $cgi = $req->cgi;
+ my $msg;
+ my $session = _get_session($req, $article, \$msg)
+ or return $self->edit_form($req, $article, $articles, $msg);
+
+ my %fields = %session_fields;
+ my $cfg_fields = $req->configure_fields(\%fields, SECT_SEMSESSION_VALIDATION);
+ my $location = $session->location;
+
+ my $it = BSE::Util::Iterate->new;
+ my %acts;
+ my $cur_session;
+ %acts =
+ (
+ $self->low_edit_tags(\%acts, $req, $article, $articles, undef, $errors),
+ field => [ \&tag_field, $cfg_fields ],
+ session => [ \&tag_hash, $session ],
+ location => [ \&tag_hash, $location ],
+ $it->make_iterator
+ ([ \&iter_other_sessions, $article, $session ],
+ 'other_session', 'other_sessions', undef, undef, undef, \$cur_session),
+ other_location => [ \&tag_other_location, \$cur_session ],
+ );
+
+ return $req->dyn_response('admin/semsessiondel', \%acts);
+}
+
+sub req_delsemsession {
+ my ($self, $req, $article, $articles) = @_;
+
+ my $cgi = $req->cgi;
+ my $msg;
+ my $session = _get_session($req, $article, \$msg)
+ or return $self->edit_form($req, $article, $articles, $msg);
+
+ my %errors;
+
+ # which session are bookings moving to
+ my $other_session_id = $cgi->param('othersession_id');
+ my $other_session;
+ if ($other_session_id) {
+ if ($other_session_id != -1) {
+ $other_session = BSE::TB::SeminarSession->getByPkey($other_session_id);
+ if (!$other_session
+ || $other_session->{seminar_id} != $article->{id}
+ || $other_session->{id} == $session->{id}) {
+ $errors{othersession_id} = "Invalid alternate section selected";
+ }
+ }
+ }
+ else {
+ $errors{othersession_id} = "Please select cancel or the session to move bookings to";
+ }
+
+ keys %errors
+ and return $self->req_askdelsemsession($req, $article, $articles, \%errors);
+
+ my %session = %$session;
+
+ my @msgs = 'Seminar session deleted';
+
+ if ($cgi->param('notify')) {
+ my $location = $session->location;
+ my @bookings = $session->booked_users();
+ my $notify_sect = 'Session Change Notification';
+ require BSE::Mail;
+ my $cfg = $req->cfg;
+ my $mailer = BSE::Mail->new(cfg=>$cfg);
+ my $from = $cfg->entry($notify_sect, 'from',
+ $cfg->entry('shop', 'from', $Constants::SHOP_FROM));
+ my @errors;
+ my $sent;
+ for my $user (@bookings) {
+ my %acts;
+ %acts =
+ (
+ session => [ \&tag_hash_plain, $session ],
+ seminar => [ \&tag_hash_plain, $article ],
+ location => [ \&tag_hash_plain, $location ],
+ ifCancelled => $other_session_id == -1,
+ );
+ my $subject;
+ if ($other_session) {
+ $subject = "Session Merged";
+ $acts{new_session} = [ \&tag_hash_plain, $other_session ];
+ $acts{new_location} = [ \&tag_hash_plain, $other_session->location ],
+ }
+ else {
+ $subject = "Session Cancelled";
+ }
+
+ if ($mailer->complex_mail(from=>$from,
+ to=>$user->{email},
+ template=>'user/sessiondeletenotify',
+ acts=>\%acts,
+ section=>$notify_sect,
+ subject=>$subject)) {
+ ++$sent;
+ }
+ else {
+ push @errors, "Error sending notification to $user->{email}:"
+ . $mailer->errstr;
+ }
+ }
+
+ if (@bookings) {
+ if ($sent) {
+ $msgs[0] .= " ($sent users notified by email about the change)";
+ if (@errors > 5) {
+ # something really wrong, dump them to the error log and trim the list
+ print STDERR $_ for @errors;
+ my $total = @errors;
+ splice @errors, 5;
+ push @errors, "(more errors omitted - total of $total errors)";
+ }
+ push @msgs, @errors;
+ }
+ }
+ else {
+ $msgs[0] .= ' (No users were booked for this session to be notified)';
+ }
+ }
+
+ if ($other_session) {
+ $session->replace_with($other_session_id);
+ }
+ else {
+ $session->cancel;
+ }
+
+ return $self->refresh($article, $cgi, undef, \@msgs);
+}
+
+sub req_takesessionrole {
+ my ($self, $req, $article, $articles, $errors) = @_;
+
+ my $cgi = $req->cgi;
+ my $msg;
+ my $session = _get_session($req, $article, \$msg)
+ or return $self->edit_form($req, $article, $articles, $msg);
+
+ my @roll_call = $session->roll_call_entries;
+ my %acts;
+ my $it = BSE::Util::Iterate->new;
+ %acts =
+ (
+ $self->low_edit_tags(\%acts, $req, $article, $articles, undef, $errors),
+ $it->make_iterator(undef, 'rolluser', 'rollusers', \@roll_call),
+ session=>[ \&tag_hash, $session ],
+ );
+
+ return $req->dyn_response('admin/semsessionrollcall', \%acts);
+}
+
+sub req_takesessionrolesave {
+ my ($self, $req, $article, $articles) = @_;
+
+ my $cgi = $req->cgi;
+ my $msg;
+ my $session = _get_session($req, $article, \$msg)
+ or return $self->edit_form($req, $article, $articles, $msg);
+
+ my @roll_call = $session->roll_call_entries;
+
+ for my $userid (map $_->{id}, @roll_call) {
+ my $there = $cgi->param("roll_present_$userid");
+ $session->set_roll_present($userid, $there);
+ }
+ $session->{roll_taken} = 1;
+ $session->save;
+
+ return $self->refresh($article, $cgi, undef, "Roll saved");
+}
+
1;
$self->{errstr};
}
+sub complex_mail {
+ my ($self, %opts) = @_;
+
+ my $cfg = $self->{cfg};
+ my $section = $opts{section}
+ or confess "No section supplied to complex_mail";
+ my $template = $opts{template}
+ or confess "No template supplied to complex_mail";
+ my $acts = $opts{acts}
+ or confess "No acts supplied to complex_mail";
+
+ require BSE::Template;
+ # other tags will be added here
+ my %acts =
+ (
+ %$acts,
+ );
+
+ my $subject_alt = $cfg->entry($section, 'subject');
+ if ($subject_alt) {
+ # do template replacement on the subject
+ my $subject = BSE::Template->replace_template($subject_alt, \%acts);
+
+ # subject may no contain newlines, and tab is bad too
+ $subject =~ tr[\x0a\x0d\t][ ]s;
+ $opts{subject} = $subject;
+ }
+
+ my $content = BSE::Template->get_page($template, $cfg, \%acts);
+ return $self->send(%opts, body=>$content);
+}
+
1;
my $cfg = $self->cfg;
require BSE::Validate;
- BSE::Validate::bse_configure_fields($fields, $cfg, $section);
+ my $cfg_fields = BSE::Validate::bse_configure_fields($fields, $cfg, $section);
for my $name (keys %$fields) {
for my $cfg_name (qw/htmltype type width height size maxlength/) {
my $value = $cfg->entry($section, "${name}_${cfg_name}");
- defined $value and $fields->{$name}{$cfg_name} = $value;
+ defined $value and $cfg_fields->{$name}{$cfg_name} = $value;
}
}
+
+ $cfg_fields;
}
sub DESTROY {
use Product;
use vars qw/@ISA/;
@ISA = qw/Product/;
-
-# subscription_usage values
-use constant SUBUSAGE_START_ONLY => 1;
-use constant SUBUSAGE_RENEW_ONLY => 2;
-use constant SUBUSAGE_EITHER => 3;
+use BSE::Util::SQL qw(now_sqldatetime);
sub columns {
return ($_[0]->SUPER::columns(),
return { seminar_id=>{ class=>'Product'} };
}
+sub sessions {
+ my ($self) = @_;
+
+ require BSE::TB::SeminarSessions;
+ BSE::TB::SeminarSessions->getBy(session_id => $self->{id});
+}
+
+sub future_sessions {
+ my ($self) = @_;
+
+ require BSE::TB::SeminarSessions;
+ BSE::TB::SeminarSessions->getSpecial(futureSessions => $self->{id}, now_sqldatetime());
+}
+
+sub session_info {
+ my ($self) = @_;
+
+ BSE::DB->query(seminarSessionInfo => $self->{id});
+}
+
+sub add_session {
+ my ($self, $when, $location) = @_;
+
+ require BSE::TB::SeminarSessions;
+ my %cols =
+ (
+ seminar_id => $self->{id},
+ when_at => $when,
+ location_id => ref $location ? $location->{id} : $location,
+ roll_taken => 0,
+ );
+ my @cols = BSE::TB::SeminarSession->columns;
+ shift @cols;
+ return BSE::TB::SeminarSessions->add(@cols{@cols});
+}
+
1;
--- /dev/null
+package BSE::TB::SeminarSession;
+use strict;
+use base qw(Squirrel::Row);
+use BSE::Util::SQL qw(now_sqldatetime);
+
+sub columns {
+ return qw/id seminar_id location_id when_at roll_taken/;
+}
+
+sub booked_users {
+ my ($self) = @_;
+
+ require SiteUsers;
+ return SiteUsers->getSpecial(sessionBookings => $self->{id});
+}
+
+# perhaps this should allow removing old sessions with no bookings
+sub is_removable {
+ my ($self) = @_;
+
+ return $self->{when_at} gt now_sqldatetime();
+}
+
+sub location {
+ my ($self) = @_;
+
+ require BSE::TB::Locations;
+ return BSE::TB::Locations->getByPkey($self->{location_id});
+}
+
+sub replace_with {
+ my ($self, $other) = @_;
+
+ # ideally we could just update the column, but that has 2 problems:
+ # - the user might be booked in both the original and new session
+ # - this would be changing the primary key of a record, which is bad
+ my %conflicts = map { $_->{id} => 1 }
+ BSE::DB->query(conflictSeminarSessions => $self->{id}, $other->{id});
+ my @users_booked = map $_->{siteuser_id},
+ BSE::DB->query(seminarSessionBookedIds => $self->{id});
+ for my $userid (@users_booked) {
+ unless ($conflicts{$userid}) {
+ BSE::DB->run(seminarSessionBookUser => $other->{id}, $userid);
+ }
+ }
+ BSE::DB->run(cancelSeminarSessionBookings => $self->{id});
+
+ $self->remove;
+}
+
+sub cancel {
+ my ($self) = @_;
+
+ BSE::DB->run(cancelSeminarSessionBookings => $self->{id});
+ $self->remove;
+}
+
+sub roll_call_entries {
+ my ($self) = @_;
+
+ BSE::DB->query(seminarSessionRollCallEntries => $self->{id});
+}
+
+sub set_roll_present {
+ my ($self, $userid, $present) = @_;
+
+ $present = $present ? 1 : 0;
+
+ BSE::DB->run(updateSessionRollPresent => $present, $self->{id}, $userid);
+}
+
+1;
+
--- /dev/null
+package BSE::TB::SeminarSessions;
+use strict;
+use base 'Squirrel::Table';
+use BSE::TB::SeminarSession;
+
+sub rowClass { 'BSE::TB::SeminarSession' }
+
+1;
my $msg = $req->message($errors);
my %fields = BSE::TB::Location->valid_fields();
- $req->configure_fields(\%fields, SECT_LOCATION_VALIDATION);
+ my $cfg_fields = $req->configure_fields(\%fields, SECT_LOCATION_VALIDATION);
my %acts;
%acts =
msg => $msg,
message => $msg,
error_img => [ \&tag_error_img, $req->cfg, $errors ],
- field => [ \&tag_field, \%fields ],
+ field => [ \&tag_field, $cfg_fields ],
);
return $req->dyn_response('admin/locations/add', \%acts);
my $msg = $req->message($errors);
my %fields = BSE::TB::Location->valid_fields();
- $req->configure_fields(\%fields, SECT_LOCATION_VALIDATION);
+ my $cfg_fields = $req->configure_fields(\%fields, SECT_LOCATION_VALIDATION);
my %acts;
%acts =
message => $msg,
error_img => [ \&tag_error_img, $req->cfg, $errors ],
location => [ \&tag_hash, $location ],
- field => [ \&tag_field, \%fields ],
+ field => [ \&tag_field, $cfg_fields ],
);
return $req->dyn_response($template, \%acts);
package DevHelp::Date;
use strict;
-require Exporter;
-use vars qw(@EXPORT_OK @ISA);
-@EXPORT_OK = qw(dh_parse_date dh_parse_date_sql);
-@ISA = qw(Exporter);
+use Exporter 'import';
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+@EXPORT_OK =
+ qw(dh_parse_date dh_parse_date_sql dh_parse_time dh_parse_time_sql);
+%EXPORT_TAGS =
+ (
+ all => \@EXPORT_OK,
+ sql => [ grep /_sql$/, @EXPORT_OK ],
+ );
use constant SECS_PER_DAY => 24 * 60 * 60;
return sprintf("%04d-%02d-%02d", $year, $month, $day);
}
+sub dh_parse_time {
+ my ($time, $rmsg) = @_;
+
+ if ($time =~ /^\s*(\d+)[:. ]?(\d{2})\s*$/) {
+ # 24 hour time
+ my ($hour, $min) = ($1, $2);
+
+ if ($hour > 23) {
+ $$rmsg = "Hour must be from 0 to 23 for 24-hour time";
+ return;
+ }
+ if ($min > 59) {
+ $$rmsg = "Minutes must be from 0 to 59";
+ return;
+ }
+
+ return (0+$hour, 0+$min, 0);
+ }
+ else {
+ # try for 12 hour time
+ my ($hour, $min, $ampm);
+
+ if ($time =~ /^\s*(\d+)\s*(?:([ap])m?)\s*$/i) {
+ # "12am", "2pm", etc
+ ($hour, $min, $ampm) = ($1, 0, $2);
+ }
+ elsif ($time =~ /^\s*(\d+)[.: ](\d{2})\s*(?:([ap])m?)\s*$/i) {
+ ($hour, $min, $ampm) = ($1, $2, $3);
+ }
+ else {
+ $$rmsg = "Unknown time format";
+ return;
+ }
+ if ($hour < 1 || $hour > 12) {
+ $$rmsg = "Hour must be from 1 to 12 for 12 hour time";
+ return;
+ }
+ if ($min > 59) {
+ $$rmsg = "Minutes must be from 0 to 59";
+ return;
+ }
+ $hour = 0 if $hour == 12;
+ $hour += 12 if lc $ampm eq 'p';
+
+ return (0+$hour, 0+$min, 0);
+ }
+}
+
+sub dh_parse_time_sql {
+ my ($time, $rmsg) = @_;
+
+ my ($hour, $min, $sec) = dh_parse_time($time, $rmsg)
+ or return;
+
+ sprintf("%02d:%02d:%02d", $hour, $min, $sec);
+}
+
1;
{
nomatch => qr/[\x0D\x0A]/,
error => '$n may only contain a single line',
- }
+ },
+ time =>
+ {
+ # we accept 24-hour time, or 12 hour with (a|p|am|pm)
+ match => qr!^(?: # first 24 hour time:
+ (?:[01]?\d|2[0-3]) # hour 0-23
+ [:.] # separator
+ [0-5]\d # minute
+ | # or 12 hour time:
+ (?:0?[1-9]|1[012]) # hour 1-12
+ (?:[:.] # optionally separator followed
+ [0-5]\d)? # by minutes
+ [ap]m? # followed by afternoon/morning
+ )$!ix,
+ error=>'Invalid time $n',
+ },
);
sub dh_validate {
'$n must be a valid date - month out of range');
last RULE;
}
+ require DevHelp::Date;
+ my $msg;
+ unless (($year, $month, $day) = DevHelp::Date::dh_parse_date($data, \$msg)) {
+ $errors->{$field} = $msg;
+ last RULE;
+ }
if ($rule->{mindate} || $rule->{maxdate}) {
- require DevHelp::Date;
my $workdate = sprintf("%04d-%02d-%02d", $year, $month, $day);
if ($rule->{mindate}) {
my $mindate = DevHelp::Date::dh_parse_date_sql($rule->{mindate});
my $result_seq = ($page_number-1) * $results_per_page;
my $excerpt;
my $keywords;
-my $words_re_str = '\b('.join('|', @terms).')\b';
+my $words_re_str = '\b('.join('|', map quotemeta, @terms).')\b';
my $words_re = qr/$words_re_str/i;
my %acts;
%acts =
# array of [ term, unquoted ]
my @terms;
- TERMS: {
+ my $found = 1;
+ while ($found) {
+ $found = 0;
if ($words =~ /\G\s*"([^"]+)"/gc
|| $words =~ /\G\s*'([^']+)'/gc) {
push(@terms, [ $1, 0 ]);
- next TERMS;
+ $found = 1;
}
- if ($words =~ /\G\s*(\S+)/gc) {
+ elsif ($words =~ /\G\s*(\S+)/gc) {
push(@terms, [ $1, 1 ]);
- next TERMS;
+ $found = 1;
}
}
=head1 CHANGES
+This is a development release, not intended for production.
+
+=head2 0.15_14
+
+=over
+
+=item *
+
+site/htdocs/images/trans_pixel.gif is now transparent again
+
+=item *
+
+search.pl would produce a 500 error if the search string contained
+regexp metacharacters (#502)
+
+=item *
+
+search.pl was only searching for the first search term
+
+=item *
+
+the shopadmin.pl product list wasn't listing seminars
+
+=item *
+
+field configuration for the location pages was being ignored
+
+=item *
+
+add.pl now generally accepts m or message for the message parameter,
+and can accept multiple messages.
+
+=item *
+
+functionality added to add, edit, delete, and take roll for sessions
+
+=back
+
=head2 0.15_13
This is a development release, not intended for production.
<tr>
<th nowrap="nowrap" align="left" bgcolor="#FFFFFF">Author name:</th>
<td width="100%" bgcolor="#FFFFFF" >
- <:ifFieldPerm author:><input type="text" name="author" value='<:ifCfg editor auto_author:><:old author adminuser name:><:or:><:old author:><:eif:>' size="40" maxlength="255" tabindex="7" /><:or:><:article author:><:eif:>
+ <:if FieldPerm author:><input type="text" name="author" value='<:ifCfg editor auto_author:><:old author adminuser name:><:or:><:old author:><:eif:>' size="40" maxlength="255" tabindex="7" /><:or FieldPerm:><:article author:><:eif FieldPerm:>
</td>
<td nowrap="nowrap" bgcolor="#FFFFFF" ><:help edit author:> <:error_img author:></td>
</tr>
:> <a href="/cgi-bin/admin/add.pl?id=<:seminar id:>&_t=steps">Manage
step parents</a> | <:if Seminar listed:> <a href="<:script:>?id=<:seminar id:>&hide=1&r=<:script:>?id=<:seminar id:>">Hide
seminar</a> |<:or Seminar:> <a href="<:script:>?id=<:seminar id:>&unhide=1&r=<:script:>?id=<:seminar id:>">Show
- seminar</a> |<:eif Seminar:><:or UserCan:><:eif UserCan:><:ifSeminar listed:><:or:> Hidden<:eif:><:eif
+ seminar</a> |<:eif Seminar:><:or UserCan:><:eif UserCan:><:ifSeminar listed:><:or:> Hidden<:eif:>
+<a href="<:script:>?id=<:seminar id:>&_t=semsessions">Manage Sessions</a> |
+<:eif
New:></p>
<h2>Seminar Details</h2>
<:ifNew:><:or:><:if Or [iadminuser_count] [iadmingroup_count]:>
--- /dev/null
+<:wrap admin/xbase.tmpl title=>"Seminar [seminar title] - Add Session":>
+<h1>Seminar <:seminar title:> - Add Session</h1>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:>
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a>
+| <a href="<:script:>?id=<:seminar id:>">Edit seminar</a> |
+ <a href="<:script:>?id=<:seminar id:>&_t=semsessions">Session list</a> |
+</p>
+
+<form action="<:script:>" method="post">
+<input type="hidden" name="id" value="<:seminar id:>" />
+<input type="hidden" name="_t" value="semsessadd" />
+<input type="hidden" name="r" value="<:script:>?id=<:seminar id:>&_t=semsessions" />
+<table>
+ <tr>
+ <th>Location:</th>
+ <td><select name="location_id">
+<option value="">(select a location)</option>
+<:iterator begin locations enabled:>
+<option value="<:location id:>" <:ifEq [old location_id] [location id]:>selected="selected"<:or:><:eif:>><:location description:></option>
+<:iterator end locations:>
+ </select></td>
+ <td><:error_img location_id:><:help semsessadd location:></td>
+ </tr>
+ <tr>
+ <th>Date:</th>
+ <td><input type="text" name="when_at_date" value ="<:old when_at_date:>" size="10" /> (dd/mm/yy)</td>
+ <td><:error_img when_at_date:><:help semsessadd date:></td>
+ </tr>
+ <tr>
+ <th>Time:</th>
+ <td><input type="text" name="when_at_time" value ="<:old when_at_time:>" size="10" /> (HH:MM or HH:MMpm or HH:MMam)</td>
+ <td><:error_img when_at_date:><:help semsessadd time:></td>
+ </tr>
+ <tr>
+ <td colspan="3"><input type="submit" name="a_addsemsession" value="Add Session" /></td>
+ </tr>
+</table>
--- /dev/null
+<:wrap admin/xbase.tmpl title=>"Seminar [seminar title] - Sessions":>
+<h1>Seminar <:seminar title:> - Sessions</h1>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:>
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> | <a href="<:script:>?id=<:seminar id:>">Edit seminar</a> |
+Show: <:ifEq [cgi s] "all":><a href="<:script:>?id=<:seminar id:>&_t=semsessions">Only new sessions</a><:or:><a href="<:script:>?id=<:seminar id:>&_t=semsessions&s=all">All sessions</a><:eif:> |
+<a href="<:script:>?id=<:seminar id:>&_t=semsessadd">Add new session</a> |
+</p>
+
+<table>
+ <tr>
+ <th>Location</th>
+ <th>Date / Time</th>
+ <td></td>
+ </tr>
+<:if Sessions:>
+<:iterator begin sessions:>
+ <tr>
+ <td><:session description:></td>
+ <td><:date "%H:%M %a %d %b %Y" session when_at:></td>
+ <td><:ifSession past:><a href="<:script:>?a_takesessionrole=1&id=<:seminar id:>&session_id=<:session id:>">Roll call</a><:
+or:><a href="<:script:>?a_editsemsession=1&id=<:seminar id:>&session_id=<:session id:>">Edit</a><:eif:>
+<:ifSessionRemovable:><a href="<:script:>?a_askdelsemsession=1&id=<:seminar id:>&session_id=<:session id:>">Delete</a><:or:><:eif:>
+</td>
+ </tr>
+<:iterator end sessions:>
+<:or Sessions:>
+ <tr>
+ <td colspan="3">No sessions found for this seminar</td>
+ </tr>
+<:eif Sessions:>
+</table>
\ No newline at end of file
</tr>
<tr>
<th><:field suburb description:>:</th>
- <td><input type="text" name="suburb" value="<:old suburb:>" maxlength="<:field suburb maxlength:>" size="<:field suburb width:>" /><:ifField street2 required:>*<:or:><:eif:></td>
+ <td><input type="text" name="suburb" value="<:old suburb:>" maxlength="<:field suburb maxlength:>" size="<:field suburb width:>" /><:ifField suburb required:>*<:or:><:eif:></td>
<td><:error_img suburb:><:help addlocation suburb:></td>
</tr>
<tr>
</tr>
<tr>
<th><:field suburb description:>:</th>
- <td><input type="text" name="suburb" value="<:old suburb location suburb:>" maxlength="<:field suburb maxlength:>" size="<:field suburb width:>" /><:ifField street2 required:>*<:or:><:eif:></td>
+ <td><input type="text" name="suburb" value="<:old suburb location suburb:>" maxlength="<:field suburb maxlength:>" size="<:field suburb width:>" /><:ifField suburb required:>*<:or:><:eif:></td>
<td><:error_img suburb:><:help addlocation suburb:></td>
</tr>
<tr>
--- /dev/null
+<:wrap admin/xbase.tmpl title=>"Seminar [seminar title] - Delete Session":>
+<h1>Seminar <:seminar title:> - Delete Session</h1>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:>
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a>
+| <a href="<:script:>?id=<:seminar id:>">Edit seminar</a> |
+ <a href="<:script:>?id=<:seminar id:>&_t=semsessions">Session list</a> |
+</p>
+
+<form action="<:script:>" method="post">
+<input type="hidden" name="id" value="<:seminar id:>" />
+<input type="hidden" name="session_id" value="<:session id:>" />
+<input type="hidden" name="r" value="<:script:>?id=<:seminar id:>&_t=semsessions" />
+<table>
+ <tr>
+ <th>Location:</th>
+ <td><:location description:></td>
+ </tr>
+ <tr>
+ <th>Date:</th>
+ <td><:date "%d/%m/%Y" session when_at:></td>
+ </tr>
+ <tr>
+ <th>Time:</th>
+ <td><:date "%H:%M" session when_at:></td>
+ </tr>
+ <tr>
+ <th>Move to session:</th>
+ <td>
+ <select name="othersession_id">
+ <option value="">(select a session or choose to cancel)</option>
+ <option value="-1">(Cancel the session)</option>
+<:iterator begin other_sessions:>
+ <option value="<:other_session id:>"><:other_location description:> <:date "%H:%M %d/%m/%Y" other_session when_at:></option>
+<:iterator end other_sessions:>
+ </select>
+ </td>
+ </tr>
+ <tr>
+ <th>Notify Booked Members</th>
+ <td><input type="checkbox" name="notify" <:ifOld notify:>checked="checked"<:or:><:eif:> value="1" /> A notification email will be sent to users booked for this session if this is checked.</td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td colspan="3"><input type="submit" name="a_delsemsession" value="Delete Session" /></td>
+ </tr>
+</table>
--- /dev/null
+<:wrap admin/xbase.tmpl title=>"Seminar [seminar title] - Edit Session":>
+<h1>Seminar <:seminar title:> - Edit Session</h1>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:>
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a>
+| <a href="<:script:>?id=<:seminar id:>">Edit seminar</a> |
+ <a href="<:script:>?id=<:seminar id:>&_t=semsessions">Session list</a> |
+</p>
+
+<form action="<:script:>" method="post">
+<input type="hidden" name="id" value="<:seminar id:>" />
+<input type="hidden" name="session_id" value="<:session id:>" />
+<input type="hidden" name="r" value="<:script:>?id=<:seminar id:>&_t=semsessions" />
+<table>
+ <tr>
+ <th>Location:</th>
+ <td><select name="location_id">
+<option value="">(select a location)</option>
+<:iterator begin locations enabled:>
+<option value="<:location id:>" <:ifEq [old location_id session location_id] [location id]:>selected="selected"<:or:><:eif:>><:location description:></option>
+<:iterator end locations:>
+ </select></td>
+ <td><:error_img location_id:><:help semsessadd location:></td>
+ </tr>
+ <tr>
+ <th>Date:</th>
+ <td><input type="text" name="when_at_date" value ="<:old when_at_date date "%d/%m/%Y" session when_at:>" size="10" /> (dd/mm/yy)</td>
+ <td><:error_img when_at_date:><:help semsessadd date:></td>
+ </tr>
+ <tr>
+ <th>Time:</th>
+ <td><input type="text" name="when_at_time" value ="<:old when_at_time date "%H:%M" session when_at:>" size="10" /> (HH:MM or HH:MMpm or HH:MMam)</td>
+ <td><:error_img when_at_date:><:help semsessedit time:></td>
+ </tr>
+ <tr>
+ <th>Notify Booked Members</th>
+ <td><input type="checkbox" name="notify" <:ifOld notify:>checked="checked"<:or:><:eif:> value="1" /> A notification email will be sent to users booked for this session if this is checked.</td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td colspan="3"><input type="submit" name="a_savesemsession" value="Save Session" /></td>
+ </tr>
+</table>
--- /dev/null
+<:wrap admin/xbase.tmpl title=>"Seminar [seminar title] - Edit Session":>
+<h1>Seminar <:seminar title:> - Edit Session</h1>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:>
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a>
+| <a href="<:script:>?id=<:seminar id:>">Edit seminar</a> |
+ <a href="<:script:>?id=<:seminar id:>&_t=semsessions">Session list</a> |
+</p>
+
+<form action="<:script:>" method="post" name="rollcall">
+<input type="hidden" name="id" value="<:seminar id:>" />
+<input type="hidden" name="session_id" value="<:session id:>" />
+<input type="hidden" name="r" value="<:script:>?id=<:seminar id:>&_t=semsessions&s=all" />
+<table>
+ <tr>
+ <th>Present</th>
+ <th>Logon</th>
+ <th>Name</th>
+ <th>Email</th>
+ </tr>
+<:iterator begin rollusers:>
+ <tr>
+ <td><input type="checkbox" name="roll_present_<:rolluser id:>" <:ifRolluser roll_present:>checked="checked"<:or:><:eif:> /></td>
+ <td><a href="/cgi-bin/admin/siteusers.pl?a_edit=1&id=<:rolluser id:>"><:rolluser userId:></a></td>
+ <td><:rolluser name1:> <:rolluser name2:></td>
+ <td><a href="mailto:<:rolluser email:>"><:rolluser email:></a></td>
+ </tr>
+ <tr>
+ <!-- separate row to distinguish these from the save button -->
+ <td colspan="4">
+ <input type="button" value="All" onClick="set_all_roll(true)" />
+ <input type="button" value="None" onClick="set_all_roll(false)" />
+ </td>
+ </tr>
+<:iterator end rollusers:>
+ <tr>
+ <td colspan="4"><input type="submit" name="a_takesessionrolesave" value="Take Roll" /></td>
+ </tr>
+</table>
+<script>
+function set_all_roll(set_reset) {
+ var f = document.rollcall;
+ for (var i = 0; i < f.elements.length; i++) {
+ var elem = f.elements[i];
+ var elemname = elem.name;
+ if (elemname.slice(0, 13) == "roll_present_") {
+ elem.checked = set_reset;
+ }
+ }
+}
+</script>
\ No newline at end of file
--- /dev/null
+<:if Cancelled:>
+Your seminar, <:seminar title:>, has been cancelled.
+
+It was to be held at <:date "%HH:%MM on %d/%m/%Y" session when_at:> at:
+
+ <:location description:>
+ <:location room:>
+ <:location street1:>
+ <:location street2:>
+ <:location suburb:> <:location state:> <:location post_code:>
+
+<:or Cancelled:>
+
+Your seminar, <:seminar title:>, has been merged with another session.
+
+It will now be on <:date "%HH:%MM on %d/%m/%Y" other_session when_at:> at:
+
+ <:new_location description:>
+ <:new_location room:>
+ <:new_location street1:>
+ <:new_location street2:>
+ <:new_location suburb:> <:new_location state:> <:new_location post_code:>
+
+Originally your seminar was on <:date "%HH:%MM on %d/%m/%Y" session when_at:>
+at:
+
+ <:location description:>
+ <:location room:>
+ <:location street1:>
+ <:location street2:>
+ <:location suburb:> <:location state:> <:location post_code:>
+
+<:eif Cancelled:>
--- /dev/null
+#!perl -w
+use strict;
+use Test::More tests=>37;
+
+my $gotmodule;
+BEGIN { $gotmodule = use_ok('DevHelp::Date', ':all'); }
+
+SKIP:
+{
+ skip "couldn't load module", 36 unless $gotmodule;
+ my $msg;
+ is_deeply([ dh_parse_time("10:00", \$msg) ], [ 10, 0, 0 ], "parse 10:00");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("10pm", \$msg) ], [ 22, 0, 0 ], "parse 10pm");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("10 05", \$msg) ], [ 10, 5, 0 ], "parse 10 05");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("12am", \$msg) ], [ 0, 0, 0 ], "parse 12am");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("12pm", \$msg) ], [ 12, 0, 0 ], "parse 12pm");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("12.01pm", \$msg) ], [ 12, 1, 0 ], "parse 12.01pm");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("1pm", \$msg) ], [ 13, 0, 0 ], "parse 1pm");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("1.00PM", \$msg) ], [ 13, 0, 0 ], "parse 1.00PM");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("12:59PM", \$msg) ], [ 12, 59, 0 ],
+ "parse 12:59PM");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("0000", \$msg) ], [ 0, 0, 0 ], "parse 0000");
+ is($msg, undef, "no error");
+ undef $msg;
+ is_deeply([ dh_parse_time("1101", \$msg) ], [ 11, 1, 0 ], "parse 1101");
+ is($msg, undef, "no error");
+
+ # fail a bit
+ undef $msg;
+ is_deeply([ dh_parse_time("xxx", \$msg) ], [], "parse xxx");
+ is($msg, "Unknown time format", "got an error");
+ undef $msg;
+ is_deeply([ dh_parse_time("0pm", \$msg) ], [], "parse 0pm");
+ is($msg, "Hour must be from 1 to 12 for 12 hour time", "got an error");
+ undef $msg;
+ is_deeply([ dh_parse_time("13pm", \$msg) ], [], "parse 13pm");
+ is($msg, "Hour must be from 1 to 12 for 12 hour time", "got an error");
+ undef $msg;
+ is_deeply([ dh_parse_time("12:60am", \$msg) ], [], "parse 12:60am");
+ is($msg, "Minutes must be from 0 to 59", "got an error");
+ undef $msg;
+ is_deeply([ dh_parse_time("2400", \$msg) ], [], "parse 2400");
+ is($msg, "Hour must be from 0 to 23 for 24-hour time", "got an error");
+ undef $msg;
+ is_deeply([ dh_parse_time("1360", \$msg) ], [], "parse 1360");
+ is($msg, "Minutes must be from 0 to 59", "got an error");
+
+ # sql times
+
+ undef $msg;
+ is(dh_parse_time_sql("2:30pm"), "14:30:00", "2:30pm to sql");
+ is($msg, undef, "no error");
+}
#inpho.test_url=http://www.develop-help.com/cgi-bin/inphotest.pl
#inpho.test_user=test
#inpho.test_password=test
+
+bse location validation.postcode_description=Funky Postcode
projects / bse.git / commitdiff
