site/cgi-bin/modules/BSE/Edit/Seminar.pm

   1 package BSE::Edit::Seminar;
   2 use strict;
   3 use base 'BSE::Edit::Product';
   4 use BSE::TB::Seminars;
   5 use BSE::Util::Tags qw(tag_hash tag_hash_mbcs);
   6 use BSE::Util::SQL qw(now_sqldatetime);
   7 use DevHelp::Date qw(dh_parse_date_sql dh_parse_time_sql);
   8 use constant SECT_SEMSESSION_VALIDATION => 'BSE Seminar Session Validation';
   9 use DevHelp::HTML qw(escape_html);
  10 use BSE::Util::Iterate;
  11
  12 sub article_actions {
  13   my ($self) = @_;
  14
  15   return
  16     (
  17      $self->SUPER::article_actions(),
  18      a_addsemsession => 'req_addsemsession',
  19      a_editsemsession => 'req_editsemsession',
  20      a_savesemsession => 'req_savesemsession',
  21      a_askdelsemsession => 'req_askdelsemsession',
  22      a_delsemsession => 'req_delsemsession',
  23      a_takesessionrole => 'req_takesessionrole',
  24      a_takesessionrolesave => 'req_takesessionrolesave',
  25     );
  26 }
  27
  28 sub edit_template {
  29   my ($self, $article, $cgi) = @_;
  30
  31   my $base = 'seminar';
  32   my $t = $cgi->param('_t');
  33   if ($t && $t =~ /^\w+$/) {
  34     $base = $t;
  35   }
  36   return $self->{cfg}->entry('admin templates', $base,
  37                              "admin/edit_$base");
  38 }
  39
  40 sub generator { "BSE::Generate::Seminar" }
  41
  42 sub default_template {
  43   my ($self, $article, $cfg, $templates) = @_;
  44
  45   my $template = $cfg->entry('seminars', 'template');
  46   return $template
  47     if $template && grep $_ eq $template, @$templates;
  48
  49   return $self->SUPER::default_template($article, $cfg, $templates);
  50 }
  51
  52 sub flag_sections {
  53   my ($self) = @_;
  54
  55   return ( 'seminar flags', $self->SUPER::flag_sections );
  56 }
  57
  58 sub type_default_value {
  59   my ($self, $req, $col) = @_;
  60
  61   my $value = $req->cfg->entry('seminar defaults', $col);
  62   defined $value and return $value;
  63
  64   return $self->SUPER::type_default_value($req, $col);
  65 }
  66
  67 sub add_template {
  68   my ($self, $article, $cgi) = @_;
  69
  70   return $self->{cfg}->entry('admin templates', 'add_seminar',
  71                              'admin/edit_seminar');
  72 }
  73
  74 sub table_object {
  75   my ($self, $articles) = @_;
  76
  77   'BSE::TB::Seminars';
  78 }
  79
  80 sub low_edit_tags {
  81   my ($self, $acts, $req, $article, $articles, $msg, $errors) = @_;
  82
  83   my $cfg = $req->cfg;
  84   my $mbcs = $cfg->entry('html', 'mbcs', 0);
  85   my $tag_hash = $mbcs ? \&tag_hash_mbcs : \&tag_hash;
  86   my $cur_session;
  87   my $it = BSE::Util::Iterate->new;
  88   return
  89     (
  90      seminar => [ $tag_hash, $article ],
  91      $self->SUPER::low_edit_tags($acts, $req, $article, $articles, $msg,
  92                                 $errors),
  93      $it->make_iterator
  94      ([ \&iter_sessions, $article, $req ], 'session', 'sessions',
  95       undef, undef, undef, \$cur_session),
  96      $it->make_iterator
  97      ([ \&iter_locations, $article ], 'location', 'locations'),
  98      ifSessionRemovable => [ \&tag_ifSessionRemovable, \$cur_session ],
  99     );
 100 }
 101
 102 sub tag_ifSessionRemovable {
 103   my ($rcur_session) = @_;
 104
 105   $$rcur_session or return 0;
 106
 107   $$rcur_session->{when_at} gt now_sqldatetime();
 108 }
 109
 110 sub iter_sessions {
 111   my ($seminar, $req, $args) = @_;
 112
 113   my $which = $args || $req->cgi->param('s') || '';
 114
 115   $seminar->{id} or return;
 116
 117   my @sessions = $seminar->session_info;
 118
 119   # synthesize the past entry
 120   my $sql_now = now_sqldatetime();
 121   for my $session (@sessions) {
 122     $session->{past} = $session->{when_at} lt $sql_now ? 1 : 0;
 123   }
 124
 125   if ($which ne 'all') {
 126     @sessions = grep !$_->{past}, @sessions;
 127   }
 128
 129   @sessions;
 130 }
 131
 132 sub iter_locations {
 133   my ($seminar, $req, $args) = @_;
 134
 135   $args ||= '';
 136
 137   require BSE::TB::Locations;
 138   my @locations = BSE::TB::Locations->all;
 139   unless ($args eq 'all') {
 140     @locations = grep !$_->{disabled}, @locations;
 141   }
 142
 143   @locations;
 144 }
 145
 146 sub get_article {
 147   my ($self, $articles, $article) = @_;
 148
 149   return BSE::TB::Seminars->getByPkey($article->{id});
 150 }
 151
 152 my %defaults =
 153   (
 154    duration => 60,
 155   );
 156
 157 sub default_value {
 158   my ($self, $req, $article, $col) = @_;
 159
 160   my $value = $self->SUPER::default_value($req, $article, $col);
 161   defined $value and return $value;
 162
 163   exists $defaults{$col} and return $defaults{$col};
 164
 165   return;
 166 }
 167
 168 sub _fill_seminar_data {
 169   my ($self, $req, $data, $src) = @_;
 170
 171   if (exists $src->{duration}) {
 172     $data->{duration} = $src->{duration};
 173   }
 174 }
 175
 176 sub fill_new_data {
 177   my ($self, $req, $data, $articles) = @_;
 178
 179   $self->_fill_seminar_data($req, $data, $data);
 180
 181   return $self->SUPER::fill_new_data($req, $data, $articles);
 182 }
 183
 184 sub fill_old_data {
 185   my ($self, $req, $article, $src) = @_;
 186
 187   $self->_fill_seminar_data($req, $article, $src);
 188
 189   return $self->SUPER::fill_old_data($req, $article, $src);
 190 }
 191
 192 sub _validate_common {
 193   my ($self, $data, $articles, $errors) = @_;
 194
 195   my $duration = $data->{duration};
 196   if (defined $duration && $duration !~ /^\d+\s*$/) {
 197     $errors->{duration} = "Duration invalid";
 198   }
 199
 200   return $self->SUPER::_validate_common($data, $articles, $errors);
 201 }
 202
 203 my %session_fields =
 204   (
 205    location_id => { description => "Location",
 206                     rules=>"required;positiveint" },
 207    when_at_date => { description => "Date",
 208                      rules => "required;futuredate" },
 209    when_at_time => { description => "Time",
 210                      rules => "required;time" },
 211   );
 212
 213 sub req_addsemsession {
 214   my ($self, $req, $article, $articles) = @_;
 215
 216   my $cgi = $req->cgi;
 217
 218   my %fields = %session_fields;
 219   my %errors;
 220   $req->validate(errors=>\%errors,
 221                  fields=>\%fields,
 222                  section=>SECT_SEMSESSION_VALIDATION);
 223   my $location_id;
 224   my $location;
 225   unless ($errors{location_id}) {
 226     require BSE::TB::Locations;
 227
 228     $location_id = $cgi->param('location_id');
 229     $location = BSE::TB::Locations->getByPkey($location_id)
 230       or $errors{location_id} = "Unknown location";
 231   }
 232   my $when;
 233   unless (keys %errors) {
 234     require BSE::TB::SeminarSessions;
 235     my $date = dh_parse_date_sql($cgi->param('when_at_date'));
 236     my $time = dh_parse_time_sql($cgi->param('when_at_time'));
 237     $when = "$date $time";
 238
 239     my ($existing) = BSE::TB::SeminarSessions->getBy(location_id=>$location_id,
 240                                                    when_at=>$when);
 241     if ($existing) {
 242       $errors{location_id} = $errors{when_at_date} =
 243         $errors{when_at_time} = "A session is already booked for that date and time at this location";
 244     }
 245   }
 246   keys %errors
 247     and return $self->edit_form($req, $article, $articles, undef, \%errors);
 248
 249   my $session = $article->add_session($when, $location);
 250
 251   return $self->refresh($article, $cgi, undef, 'Session added');
 252 }
 253
 254 sub _get_session {
 255   my ($req, $article, $rmsg) = @_;
 256
 257   my $cgi = $req->cgi;
 258   my $session_id = $cgi->param('session_id');
 259   defined $session_id && $session_id =~ /^\d+$/
 260     or do { $$rmsg = "Missing or invalid session id"; return; };
 261   require BSE::TB::SeminarSessions;
 262   my $session = BSE::TB::SeminarSessions->getByPkey($session_id)
 263     or do { $$rmsg = "Unknown session $session_id"; return; };
 264   $session->{seminar_id} == $article->{id}
 265     or do { $$rmsg = "Session does not belong to this seminar"; return };
 266
 267   return $session;
 268 }
 269
 270 sub req_editsemsession {
 271   my ($self, $req, $article, $articles, $errors) = @_;
 272
 273   my $cgi = $req->cgi;
 274   my $msg;
 275   my $session = _get_session($req, $article, \$msg)
 276     or return $self->edit_form($req, $article, $articles, $msg);
 277
 278   my %fields = %session_fields;
 279   my $cfg_fields = $req->configure_fields(\%fields, SECT_SEMSESSION_VALIDATION);
 280
 281   my %acts;
 282   %acts =
 283     (
 284      $self->low_edit_tags(\%acts, $req, $article, undef, $errors),
 285      field => [ \&tag_field, $cfg_fields ],
 286      session => [ \&tag_hash, $session ],
 287     );
 288
 289   return $req->dyn_response('admin/semsessionedit.tmpl', \%acts);
 290 }
 291
 292 sub req_savesemsession {
 293   my ($self, $req, $article, $articles) = @_;
 294
 295   my $cgi = $req->cgi;
 296   my $msg;
 297   my $session = _get_session($req, $article, \$msg)
 298     or return edit_form($req, $article, $articles, $msg);
 299
 300   my %fields = %session_fields;
 301   my %errors;
 302   $req->validate(errors=>\%errors,
 303                  fields=>\%fields,
 304                  section=>SECT_SEMSESSION_VALIDATION);
 305   my $location_id;
 306   my $location;
 307   unless ($errors{location_id}) {
 308     require BSE::TB::Locations;
 309
 310     $location_id = $cgi->param('location_id');
 311     $location = BSE::TB::Locations->getByPkey($location_id)
 312       or $errors{location_id} = "Unknown location";
 313   }
 314   my $when;
 315   unless (keys %errors) {
 316     require BSE::TB::SeminarSessions;
 317     my $date = dh_parse_date_sql($cgi->param('when_at_date'));
 318     my $time = dh_parse_time_sql($cgi->param('when_at_time'));
 319     $when = "$date $time";
 320
 321     my ($existing) = BSE::TB::SeminarSessions->getBy(location_id=>$location_id,
 322                                                    when_at=>$when);
 323     if ($existing && $existing->{session_id} != $session->{session_id}) {
 324       $errors{location_id} = $errors{when_at_date} =
 325         $errors{when_at_time} = "A session is already booked for that date and time at this location";
 326     }
 327   }
 328   keys %errors
 329     and return $self->edit_form($req, $article, $articles, undef, \%errors);
 330
 331   my $old_location_id = $session->{location_id};
 332   my $old_when = $session->{when_at};
 333   $session->{location_id} = $location_id;
 334   $session->{when_at} = $when;
 335   $session->save;
 336
 337   my @msgs = 'Seminar session saved';
 338
 339   if ($cgi->param('notify')
 340       && ($session->{location_id} != $old_location_id
 341           || $session->{when_at} ne $old_when)) {
 342     my $old_location = BSE::TB::Locations->getByPkey($old_location_id);
 343     my @bookings = $session->booked_users();
 344     my $notify_sect = 'Session Change Notification';
 345     require BSE::Mail;
 346     my $cfg = $req->cfg;
 347     my $mailer = BSE::Mail->new(cfg=>$cfg);
 348     my $from = $cfg->entry($notify_sect, 'from',
 349                            $cfg->entry('shop', 'from', $Constants::SHOP_FROM));
 350     my @errors;
 351     my $sent;
 352     for my $user (@bookings) {
 353       my %acts;
 354       %acts =
 355         (
 356          session => [ \&tag_hash_plain, $session ],
 357          seminar => [ \&tag_hash_plain, $article ],
 358          old_when => $old_when,
 359          old_location => [ \&tag_hash_plain, $old_location ],
 360          location => [ \&tag_hash_plain, $location ],
 361         );
 362
 363       if ($mailer->complex_mail(from=>$from,
 364                                 to=>$user->{email},
 365                                 template=>'user/sessionchangenotify',
 366                                 acts=>\%acts,
 367                                 section=>$notify_sect,
 368                                 subject=>'Session Rescheduled')) {
 369         ++$sent;
 370       }
 371       else {
 372         push @errors, "Error sending notification to $user->{email}:"
 373           . $mailer->errstr;
 374       }
 375     }
 376
 377     if (@bookings) {
 378       if ($sent) {
 379         $msgs[0] .= " ($sent users notified by email about the change)";
 380         if (@errors > 5) {
 381           # something really wrong, dump them to the error log and trim the list
 382           print STDERR $_ for @errors;
 383           my $total = @errors;
 384           splice @errors, 5;
 385           push @errors, "(more errors omitted - total of $total errors)";
 386         }
 387         push @msgs, @errors;
 388       }
 389     }
 390     else {
 391       $msgs[0] .= ' (No users were booked for this session to be notified)';
 392     }
 393   }
 394
 395   return $self->refresh($article, $cgi, undef, \@msgs);
 396 }
 397
 398 sub iter_other_sessions {
 399   my ($seminar, $session) = @_;
 400
 401   grep $_->{id} != $session->{id}, $seminar->future_sessions;
 402 }
 403
 404 sub tag_other_location {
 405   my ($rcur_session, $arg) = @_;
 406
 407   $$rcur_session or return '';
 408   my $location = $$rcur_session->location;
 409
 410   my $value = $location->{$arg};
 411   defined $value or return '';
 412
 413   escape_html($value);
 414 }
 415
 416 sub req_askdelsemsession {
 417   my ($self, $req, $article, $articles, $errors) = @_;
 418
 419   my $cgi = $req->cgi;
 420   my $msg;
 421   my $session = _get_session($req, $article, \$msg)
 422     or return $self->edit_form($req, $article, $articles, $msg);
 423
 424   my %fields = %session_fields;
 425   my $cfg_fields = $req->configure_fields(\%fields, SECT_SEMSESSION_VALIDATION);
 426   my $location = $session->location;
 427
 428   my $it = BSE::Util::Iterate->new;
 429   my %acts;
 430   my $cur_session;
 431   %acts =
 432     (
 433      $self->low_edit_tags(\%acts, $req, $article, $articles, undef, $errors),
 434      field => [ \&tag_field, $cfg_fields ],
 435      session => [ \&tag_hash, $session ],
 436      location => [ \&tag_hash, $location ],
 437      $it->make_iterator
 438      ([ \&iter_other_sessions, $article, $session ],
 439       'other_session', 'other_sessions', undef, undef, undef, \$cur_session),
 440      other_location => [ \&tag_other_location, \$cur_session ],
 441     );
 442
 443   return $req->dyn_response('admin/semsessiondel', \%acts);
 444 }
 445
 446 sub req_delsemsession {
 447   my ($self, $req, $article, $articles) = @_;
 448
 449   my $cgi = $req->cgi;
 450   my $msg;
 451   my $session = _get_session($req, $article, \$msg)
 452     or return $self->edit_form($req, $article, $articles, $msg);
 453
 454   my %errors;
 455
 456   # which session are bookings moving to
 457   my $other_session_id = $cgi->param('othersession_id');
 458   my $other_session;
 459   if ($other_session_id) {
 460     if ($other_session_id != -1) {
 461       $other_session = BSE::TB::SeminarSession->getByPkey($other_session_id);
 462       if (!$other_session
 463           || $other_session->{seminar_id} != $article->{id}
 464           || $other_session->{id} == $session->{id}) {
 465         $errors{othersession_id} = "Invalid alternate section selected";
 466       }
 467     }
 468   }
 469   else {
 470     $errors{othersession_id} = "Please select cancel or the session to move bookings to";
 471   }
 472
 473   keys %errors
 474     and return $self->req_askdelsemsession($req, $article, $articles, \%errors);
 475
 476   my %session = %$session;
 477
 478   my @msgs = 'Seminar session deleted';
 479
 480   if ($cgi->param('notify')) {
 481     my $location = $session->location;
 482     my @bookings = $session->booked_users();
 483     my $notify_sect = 'Session Change Notification';
 484     require BSE::Mail;
 485     my $cfg = $req->cfg;
 486     my $mailer = BSE::Mail->new(cfg=>$cfg);
 487     my $from = $cfg->entry($notify_sect, 'from',
 488                            $cfg->entry('shop', 'from', $Constants::SHOP_FROM));
 489     my @errors;
 490     my $sent;
 491     for my $user (@bookings) {
 492       my %acts;
 493       %acts =
 494         (
 495          session => [ \&tag_hash_plain, $session ],
 496          seminar => [ \&tag_hash_plain, $article ],
 497          location => [ \&tag_hash_plain, $location ],
 498          ifCancelled => $other_session_id == -1,
 499         );
 500       my $subject;
 501       if ($other_session) {
 502         $subject = "Session Merged";
 503         $acts{new_session} = [ \&tag_hash_plain, $other_session ];
 504         $acts{new_location} = [ \&tag_hash_plain, $other_session->location ],
 505       }
 506       else {
 507         $subject = "Session Cancelled";
 508       }
 509
 510       if ($mailer->complex_mail(from=>$from,
 511                                 to=>$user->{email},
 512                                 template=>'user/sessiondeletenotify',
 513                                 acts=>\%acts,
 514                                 section=>$notify_sect,
 515                                 subject=>$subject)) {
 516         ++$sent;
 517       }
 518       else {
 519         push @errors, "Error sending notification to $user->{email}:"
 520           . $mailer->errstr;
 521       }
 522     }
 523
 524     if (@bookings) {
 525       if ($sent) {
 526         $msgs[0] .= " ($sent users notified by email about the change)";
 527         if (@errors > 5) {
 528           # something really wrong, dump them to the error log and trim the list
 529           print STDERR $_ for @errors;
 530           my $total = @errors;
 531           splice @errors, 5;
 532           push @errors, "(more errors omitted - total of $total errors)";
 533         }
 534         push @msgs, @errors;
 535       }
 536     }
 537     else {
 538       $msgs[0] .= ' (No users were booked for this session to be notified)';
 539     }
 540   }
 541
 542   if ($other_session) {
 543     $session->replace_with($other_session_id);
 544   }
 545   else {
 546     $session->cancel;
 547   }
 548
 549   return $self->refresh($article, $cgi, undef, \@msgs);
 550 }
 551
 552 sub req_takesessionrole {
 553   my ($self, $req, $article, $articles, $errors) = @_;
 554
 555   my $cgi = $req->cgi;
 556   my $msg;
 557   my $session = _get_session($req, $article, \$msg)
 558     or return $self->edit_form($req, $article, $articles, $msg);
 559
 560   my @roll_call = $session->roll_call_entries;
 561   my %acts;
 562   my $it = BSE::Util::Iterate->new;
 563   %acts =
 564     (
 565      $self->low_edit_tags(\%acts, $req, $article, $articles, undef, $errors),
 566      $it->make_iterator(undef, 'rolluser', 'rollusers', \@roll_call),
 567      session=>[ \&tag_hash, $session ],
 568     );
 569
 570   return $req->dyn_response('admin/semsessionrollcall', \%acts);
 571 }
 572
 573 sub req_takesessionrolesave {
 574   my ($self, $req, $article, $articles) = @_;
 575
 576   my $cgi = $req->cgi;
 577   my $msg;
 578   my $session = _get_session($req, $article, \$msg)
 579     or return $self->edit_form($req, $article, $articles, $msg);
 580
 581   my @roll_call = $session->roll_call_entries;
 582
 583   for my $userid (map $_->{id}, @roll_call) {
 584     my $there = $cgi->param("roll_present_$userid");
 585     $session->set_roll_present($userid, $there);
 586   }
 587   $session->{roll_taken} = 1;
 588   $session->save;
 589
 590   return $self->refresh($article, $cgi, undef, "Roll saved");
 591 }
 592
 593 sub base_template_dirs {
 594   return ( "seminars" );
 595 }
 596
 597 sub extra_templates {
 598   my ($self, $article) = @_;
 599
 600   my @extras;
 601
 602   my $extras = $self->{cfg}->entry('seminars', 'extra_templates');
 603   push @extras, grep /\.(tmpl|html)$/i, split /,/, $extras
 604     if $extras;
 605
 606   return @extras;
 607 }
 608
 609 1;
 610