Subversion Repositories PEEPS

Rev

Rev 41 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 - 1
package PEEPS;
2
## PEEPS support functions...
3
 
4
use strict;
5
use Exporter 'import';
6
use CGI qw/param header start_html url/;
7
use CGI::Cookie;
8
use DBI;
9
use WebDB;
10
 
11
$SIG{__WARN__} = sub { warn sprintf("[%s] ", scalar localtime), @_ };
12
$SIG{__DIE__}  = sub { die  sprintf("[%s] ", scalar localtime), @_ };
13
 
31 - 14
our @EXPORT = qw( $ORCUSER $SYSTEM_EMAIL getRCDBH getAccessLevels authDB max authenticate canView getLeagueAffiliation getLeagueName getLeague getLeagues getShiftRef getShiftDepartment getClassID getDepartments convertDepartments convertTime getSchedule getRCid getSetting getUser getUserEmail getUserDerbyName getYears printRCHeader changeShift modShiftTime signUpCount signUpEligible findConflict changeLeadShift sendNewUserEMail sendUserMFAEMail logit orglogit isLeagueAdmin isPersonCovered isLeagueCovered isWFTDAMember remainingPolicyDays remainingOrgPolicyDays getPolicyByID getCoverageByID getOrgCoverageByID);
2 - 15
 
16
my $dbh = WebDB::connect ("peeps");
17
sub getRCDBH {
18
  return $dbh;
19
}
20
our $ORCUSER;
45 - 21
our $SYSTEM_EMAIL = getSetting ("SYSTEM_EMAIL") // 'peeps@wftdi.com';
2 - 22
use constant {
23
    NOONE     => 0,
24
    USER      => 1,
25
    VOLUNTEER => 1,
26
    LEAD      => 2,
27
    MANAGER   => 3,
28
    DIRECTOR  => 4,
29
    SYSADMIN  => 5,
30
    ADMIN     => 5
31
  };
32
 
33
sub getAccessLevels {
34
  my %AccessLevels = (
35
    -1 => "Locked",
36
 
37
#    1 => "Volunteer",
38
    1 => "User",
39
    2 => "Lead",
40
    3 => "Manager",
41
    4 => "Director",
42
    5 => "SysAdmin"
43
  );
44
  return \%AccessLevels;
45
}
46
 
47
sub authDB {
48
  my $src = shift;
49
  my $id = shift;
50
  my $pass = shift;
51
  my $level = shift;
52
  my $activationcode = shift // "";
53
  my $authentication = shift // "";
54
  my ($result, $authMatch, $sessionid);
55
 
56
  use CGI::Session;
57
 
58
  my $IDHASH;
59
 
60
  if ($src eq "form") {
61
    # check the username and password against the DB and return sessionid (if one exists) if valid.
62
    ($authMatch, $sessionid) = $dbh->selectrow_array ("select 1, sessionid from authentication where username = ? and password = password(?)", undef, $id, $pass);
63
    if ($authMatch) {
64
 
65
      my $session = CGI::Session->new ("driver:mysql", $sessionid ? $sessionid : undef, { DataSource => WebDB::SessionDSN });
66
      $session->param  ('is_logged_in', 1);
67
      $session->expire ('is_logged_in', '+30m');
68
      $session->flush;
69
      $sessionid = $session->id;
70
      $dbh->do ("update authentication set sessionid = ? where username = ?", undef, $sessionid, $id);
71
 
72
      %{$IDHASH} = (%{$dbh->selectrow_hashref ("select * from authentication where username = ?", undef, $id)},
73
                    %{$dbh->selectrow_hashref ("select * from person where id = (select person_id from authentication where username = ?)", undef, $id)});
74
    } else {
75
      $result->{ERRMSG} = "Incorrect Password!";
76
    }
77
  } else {
78
    # check the sessionid against the DB to make sure it's the same user.
79
    ($authMatch, $sessionid) = $dbh->selectrow_array ("select 1, sessionid from authentication where username = ? and sessionid = ?", undef, $id, $pass);
80
    if ($authMatch) {
81
      # the sessionid matches their DB entry, but we need to see if it's expired.
82
      my $session = CGI::Session->load ("driver:mysql", $sessionid, { DataSource => WebDB::SessionDSN });
83
      $sessionid = $session->id;
84
      if ($session->is_empty) {
85
        $result->{ERRMSG} = "Session Not Found!";
86
        $authMatch = 0;
87
      } elsif ($session->is_expired) {
88
        $result->{ERRMSG} = "Session Expired!";
89
        $authMatch = 0;
90
      } elsif (!$session->param  ('is_logged_in')) {
91
        $result->{ERRMSG} = "Session Timed Out (>30 minutes idle)!";
92
        $authMatch = 0;
93
      } else {
94
        $session->expire ('is_logged_in', '+30m');
95
        $session->flush;
96
      }
97
      %{$IDHASH} = (%{$dbh->selectrow_hashref ("select * from authentication where username = ?", undef, $id)},
98
                    %{$dbh->selectrow_hashref ("select * from person where id = (select person_id from authentication where username = ?)", undef, $id)});
99
    } else {
100
      $result->{ERRMSG} = "SECURITY ALERT: Bogus Session!";
101
    }
102
  }
103
 
104
  if ($authMatch) {
105
    # good login, but have we seen this browser before?
106
    my $query = new CGI;
107
    my $PEEPSMFACOOKIE = $query->cookie('PEEPS_MFA_UUID');
108
    my ($MFACHECK) = $dbh->selectrow_array ("select 1 from MFA where person_id = (select person_id from authentication where username = ?) and MFA_UUID = ?", undef, $id, $PEEPSMFACOOKIE);
109
 
110
    if (!$MFACHECK) {
111
      $result->{ERRMSG} = "MFA Check Required.";
112
    }
113
  }
114
 
115
 
116
 
117
 
118
#  my $tempDepartments = convertDepartments ($IDHASH->{department});
119
#  my $MAXACCESS = scalar keys %{ $tempDepartments } ? max ($IDHASH->{'access'}, values %{ $tempDepartments } ) : $IDHASH->{'access'};
120
  my $MAXACCESS = 1;
121
  my ($failed_attempts) = $dbh->selectrow_array ("select count(*) from log where person_id = ? and event = ? and timestampdiff(MINUTE, timestamp, now()) < ? and timestamp > (select timestamp from log where person_id = ? and event = ? order by timestamp desc limit 1)", undef, $IDHASH->{person_id}, "Incorrect Password", 30, $IDHASH->{person_id}, "Logged In");
122
 
123
  if (!$IDHASH->{'person_id'}) {
124
    $result->{ERRMSG} = "Username not found!";
125
    $result->{cookie_string} = '';
126
    $result->{person_id} = '';
127
    logit(0, "Account not found: $id");
128
    $result->{authenticated} = 'false';
129
    return $result;
130
  } elsif ($failed_attempts >= 3) {
131
    $result->{ERRMSG} = "Too Many Failed Login Attempts!<br>(Please wait 30 minutes before trying again.)";
132
    $result->{cookie_string} = '';
133
    $result->{person_id} = $IDHASH->{'person_id'};
134
    logit($IDHASH->{'person_id'}, "User Login Timeout");
135
    $result->{authenticated} = 'false';
136
    return $result;
137
  } elsif (!$authMatch) {
138
    $result->{cookie_string} = '';
139
    $result->{person_id} = $IDHASH->{'person_id'};
140
    logit($IDHASH->{'person_id'}, $result->{ERRMSG});
141
    ($failed_attempts) = $dbh->selectrow_array ("select count(*) from log where person_id = ? and event = ? and timestampdiff(MINUTE, timestamp, now()) < ? and timestamp > (select timestamp from log where person_id = ? and event = ? order by timestamp desc limit 1)", undef, $IDHASH->{person_id}, "Incorrect Password", 30, $IDHASH->{person_id}, "Logged In");
142
    if ($failed_attempts >=3) {
143
      $result->{ERRMSG} .= "<br>Too Many Failed Login Attempts!<br>(Please wait 30 minutes before trying again.)";
144
      logit($IDHASH->{'person_id'}, "Excessive Login Failures, 30 Minute Timeout");
145
    }
146
    $result->{authenticated} = 'false';
147
    return $result;
148
  } elsif ($IDHASH->{'locked'}) {
149
    $result->{ERRMSG} = "Account Locked!";
150
    $result->{cookie_string} = '';
151
    $result->{person_id} = $IDHASH->{'person_id'};
152
    logit($IDHASH->{'person_id'}, "Login attempted for Locked account.");
153
    $result->{authenticated} = 'false';
154
    return $result;
155
  } elsif ($IDHASH->{'activation'} ne "active") {
156
    # It's an inactive account...
157
    if ($activationcode eq "resend") {
158
      # warn "Resending activation code...";
159
      sendNewUserEMail ("New User", $IDHASH);
160
      $result->{ERRMSG} = "Activation code resent. Please check your email.";
161
      $result->{cookie_string} = "${id}&${sessionid}&0";
162
      $result->{person_id} = $IDHASH->{'person_id'};
163
      logit($IDHASH->{'person_id'}, "Activation code resent.");
164
      $result->{authenticated} = 'inactive';
165
      return $result;
166
    } elsif ($activationcode) {
167
      # They submitted an activation code
168
      if ($activationcode eq $IDHASH->{'activation'}) {
169
        # ...and it was good.
170
        $dbh->do ("update authentication set activation = 'active', locked = 0, last_login = now() where person_id = ? and activation = ?", undef, $IDHASH->{'person_id'}, $activationcode);
171
        logit($IDHASH->{'person_id'}, "Activated their account and logged In");
172
        # sendNewUserEMail ("Activate", $IDHASH);
173
        $IDHASH->{'access'} = 1;
174
        $IDHASH->{'activation'} = "active";
175
        $MAXACCESS = max ($MAXACCESS, 1);
176
      } else {
177
        # ...but it wasn't good.
178
        $result->{ERRMSG} = "Activation failed, invalid code submitted.";
179
        $result->{cookie_string} = "${id}&${sessionid}&0";;
180
        $result->{person_id} = $IDHASH->{'person_id'};
181
        logit($IDHASH->{'person_id'}, "Activation failed, invalid code submitted.");
182
        $result->{authenticated} = 'inactive';
183
        return $result;
184
      }
185
    } else {
186
      # No activation code was submitted.
187
      $result->{ERRMSG} = "Inactive account! Please check your email for activation link/code." unless $result->{ERRMSG};
188
      $result->{cookie_string} = "${id}&${sessionid}&0";
189
      $result->{person_id} = $IDHASH->{'person_id'};
190
      logit($IDHASH->{'person_id'}, "Login attempted without activation code.");
191
      $result->{authenticated} = 'inactive';
192
      return $result;
193
    }
194
  } elsif ($result->{ERRMSG} eq "MFA Check Required.") {
195
 
196
    # Need to check MFA...
197
    if ($authentication eq "resend") {
198
      sendUserMFAEMail ($IDHASH);
199
      $result->{ERRMSG} .= "<br>Activation code resent. Please check your email.";
200
      $result->{cookie_string} = "${id}&${sessionid}&0";
201
      $result->{person_id} = $IDHASH->{'person_id'};
202
      logit($IDHASH->{'person_id'}, "MFA code resent.");
203
      $result->{authenticated} = 'needsMFA';
204
      return $result;
205
    } elsif ($authentication) {
206
      # They submitted an authentication code
207
      if ($authentication =~ /^\d{6}$/ and $authentication eq $IDHASH->{'mfa'}) {
208
        # check to see how old it is...
209
        my ($code_age) = $dbh->selectrow_array ("select timestampdiff(MINUTE, mfa_timestamp, now()) from authentication where person_id = ? and mfa = ?", undef, $IDHASH->{'person_id'}, $IDHASH->{'mfa'}) // 99;
210
        if ($code_age > 10) {
211
          # ...but it was too old.
212
          $result->{ERRMSG} = "MFA Authentication failed, code is too old. Resending...";
213
          sendUserMFAEMail ($IDHASH);
214
          $result->{cookie_string} = "${id}&${sessionid}&0";
215
          $result->{person_id} = $IDHASH->{'person_id'};
216
          logit($IDHASH->{'person_id'}, "MFA Authentication failed, code is too old.");
217
          $result->{authenticated} = 'needsMFA';
218
          return $result;
219
        } else {
220
          # ...and it was good.
221
 
222
          use UUID::Tiny qw(create_UUID_as_string UUID_V4);
223
          $result->{MFA_UUID} = create_UUID_as_string(UUID_V4);
224
          $dbh->do ("insert into MFA (person_id, MFA_UUID) values (?, ?)", undef, $IDHASH->{'person_id'}, $result->{MFA_UUID});
225
 
226
          logit($IDHASH->{'person_id'}, "Authenticated with an MFA code.");
227
          $IDHASH->{'access'} = 1;
228
          $MAXACCESS = max ($MAXACCESS, 1);
229
          $result->{cookie_string} = "${id}&${sessionid}&".$MAXACCESS;
230
          $result->{authenticated} = 'confirmedMFA';
231
          return $result;
232
        }
233
      } else {
234
        # ...but it wasn't good.
235
        $result->{ERRMSG} = "MFA Authentication failed, invalid code submitted.";
236
        $result->{cookie_string} = "${id}&${sessionid}&0";
237
        $result->{person_id} = $IDHASH->{'person_id'};
238
        logit($IDHASH->{'person_id'}, "MFA Authentication failed, invalid code submitted.");
239
        $result->{authenticated} = 'needsMFA';
240
        return $result;
241
      }
242
    } else {
243
      # No activation code was submitted.
244
      sendUserMFAEMail ($IDHASH);
245
      $result->{ERRMSG} .= " Please check your email for activation code." unless $result->{ERRMSG};
246
      $result->{cookie_string} = "${id}&${sessionid}&0";
247
      $result->{person_id} = $IDHASH->{'person_id'};
248
      logit($IDHASH->{'person_id'}, "Login attempted from unrecognized location, MFA needed.");
249
      $result->{authenticated} = 'needsMFA';
250
      return $result;
251
    }
252
 
253
 
254
 
255
  }
256
 
257
  if ($MAXACCESS < $level) {
258
    if (getSetting ("MAINTENANCE")) {
259
      $result->{ERRMSG} = "MAINTENANCE MODE: Logins are temporarily disabled.";
260
    } else {
261
      $result->{ERRMSG} = "Your account either needs to be activated, or doesn't have access to this page!";
262
      logit($IDHASH->{'person_id'}, "Insufficient Privileges");
263
    }
264
    $result->{cookie_string} = "${id}&${sessionid}&$IDHASH->{'access'}";
265
    $result->{person_id} = $IDHASH->{'person_id'};
266
    $result->{authenticated} = 'false';
267
  } else {
268
    $result->{ERRMSG} = '';
269
#    $IDHASH->{department} = convertDepartments ($IDHASH->{department});
270
#    $IDHASH->{'access'} = max ($IDHASH->{'access'}, values %{$IDHASH->{department}});
40 - 271
    ($IDHASH->{'SANCTIONING'}) = $dbh->selectrow_array ("select 1 from role where person_id = ? and member_org_id = (select id from organization where league_name = ?) and role = ?", undef, $IDHASH->{person_id}, "WFTDA Leadership", "Sanctioning");
2 - 272
    ($IDHASH->{'SYSADMIN'}) = $dbh->selectrow_array ("select 1 from role where person_id = ? and member_org_id = (select id from organization where league_name = ?) and role = ?", undef, $IDHASH->{person_id}, "WFTDA Leadership", "System Admin");
273
    $IDHASH->{'access'} = $IDHASH->{'SYSADMIN'} ? 5 : 1;
274
    $result->{cookie_string} = "${id}&${sessionid}&$IDHASH->{'access'}";
275
    $result->{person_id} = $IDHASH->{'person_id'};
276
    logit($IDHASH->{'person_id'}, "Logged In") if $src eq "form";
277
    $dbh->do ("update authentication set last_login = now() where person_id = ?", undef, $IDHASH->{'person_id'}) if $src eq "form";
278
    $result->{authenticated} = 'true';
279
 
280
    $ORCUSER = $IDHASH;
281
  }
282
  return $result;
283
}
284
 
285
sub max {
286
    my ($max, $next, @vars) = @_;
287
    return $max if not $next;
288
    return max( $max > $next ? $max : $next, @vars );
289
}
290
 
291
 
292
sub authenticate {                  # Verifies the user has logged in or puts up a log in screen
293
  my $MAINTMODE = getSetting ("MAINTENANCE");
294
  my $MINLEVEL = $MAINTMODE ? $MAINTMODE : shift // 1;
295
 
296
  my ($ERRMSG, $authenticated, %FORM);
297
  my $sth = $dbh->prepare("select * from authentication where username = '?'");
298
 
299
  my $query = new CGI;
300
# Check to see if the user has already logged in (there should be cookies with their authentication)?
301
  my $PEEPSAUTH = $query->cookie('PEEPSAUTH');
302
  $FORM{'ID'} = WebDB::trim $query->param('userid') || '';
303
  $FORM{'PASS'} = WebDB::trim $query->param('pass') || '';
304
  $FORM{'SUB'} = $query->param('login') || '';
305
  $FORM{'activate'} = WebDB::trim $query->param('activate') // '';
306
  $FORM{'authenticate'} = WebDB::trim $query->param('authenticate') // '';
307
  $FORM{'saveMFA'} = WebDB::trim $query->param('saveMFA') // '';
308
 
309
  if ($PEEPSAUTH) {
310
    # We have an authenication cookie.  Double-check it
311
    my ($PEEPSID, $SESSID, $LVL) = split /&/, $PEEPSAUTH;
312
    $authenticated = authDB('cookie', $PEEPSID, $SESSID, $MINLEVEL, $FORM{'activate'}, $FORM{'authenticate'});
313
  } elsif ($FORM{'SUB'}) {
314
    # a log in form was submited
315
    if ($FORM{'SUB'} eq "Submit") {
316
      $authenticated = authDB('form', $FORM{'ID'}, $FORM{'PASS'}, $MINLEVEL, $FORM{'activate'}, $FORM{'authenticate'});
317
    } elsif ($FORM{'SUB'} eq "New User") {
318
      # Print the new user form and exit
319
    }
320
  } else {
321
    $authenticated->{authenticated} = 'false';
322
  }
323
 
324
  if ($authenticated->{authenticated} eq 'true') {
325
    use CGI::Session;
326
    my $session = CGI::Session->new ("driver:mysql", $ORCUSER->{sessionid}, { DataSource => WebDB::SessionDSN });
327
#    $session->expire ('~logged_in', '30m');
328
#    $session->flush;
329
    my $sessionid = $session->id ();
330
 
331
    # Limit how long users are allowed to stay logged in at once.
332
    #  [there's no reason to limit PEEPS session length]
333
    # my ($session_length) = $dbh->selectrow_array ("select timestampdiff(MINUTE, last_login, now()) from authentication where person_id = ?", undef, $ORCUSER->{person_id});
334
    # if ($session_length > getSetting ("MAX_SESSION_MINUTES")) {
335
    #   $ENV{'QUERY_STRING'} = "LOGOUT";
336
    #   $authenticated->{ERRMSG} = "Maximum session time exceeded.<br>";
337
    # }
338
 
339
    if ($ENV{'QUERY_STRING'} eq "LOGOUT") {
340
      # warn "logging $ORCUSER->{derby_name} out...";
341
      $authenticated->{ERRMSG} .= "Logged Out.<br>";
342
      $authenticated->{cookie_string} = "";
343
      #$session->clear ("is_logged_in");
344
      #$session->flush;
345
      $authenticated->{authenticated} = 'false';
346
      $ENV{REQUEST_URI} =~ s/LOGOUT//;
347
      logit ($ORCUSER->{person_id}, "Logged Out");
348
      $dbh->do ("update authentication set last_active = now(), sessionid = null where person_id = ?", undef, $ORCUSER->{person_id});
349
      $dbh->do ("delete from sessions where sessions.id = ?", undef, $sessionid);
350
      $ORCUSER = "";
351
    } else {
352
      $dbh->do ("update authentication set last_active = now(), sessionid = ? where person_id = ?", undef, $sessionid, $ORCUSER->{person_id});
353
      return $authenticated->{cookie_string};
354
    }
355
  } elsif ($authenticated->{authenticated} eq "confirmedMFA") {
356
    # Set the MFA cookie and redirect the user to where they were going.
357
 
358
    my $PEEPSAUTH_cookie = CGI::Cookie->new(-name=>'PEEPSAUTH',-value=>$authenticated->{cookie_string});
359
    my $PEEPSMFA_cookie = $FORM{saveMFA} ?
360
      CGI::Cookie->new(-name=>'PEEPS_MFA_UUID',-value=>$authenticated->{MFA_UUID},-expires=>'+5y') :
361
      CGI::Cookie->new(-name=>'PEEPS_MFA_UUID',-value=>$authenticated->{MFA_UUID});
362
 
4 - 363
    $ENV{HTTPS} = 'ON' if $ENV{SERVER_NAME} =~ /^peeps/;
2 - 364
    my $destination = url ();
365
    print header(-cookie=>[$PEEPSAUTH_cookie, $PEEPSMFA_cookie]);
366
    printRCHeader("MFA Confirmed", $destination);
367
    print<<goforth;
368
      Your MFA Code has been confirmed.  You may continue on your way.<br><br>
369
 
370
      <a href="$destination">Continue.</a>
371
goforth
372
    exit;
373
  }
374
 
375
 
376
# If we get here, the user has failed authentication; throw up the log-in screen and die.
377
 
378
  my $PEEPSAUTH_cookie = CGI::Cookie->new(-name=>'PEEPSAUTH',-value=>$authenticated->{cookie_string});
379
 
380
  if ($authenticated->{ERRMSG}) {
381
    $authenticated->{ERRMSG} = "<TR><TD colspan=2 align=center><font color=red><b>".$authenticated->{ERRMSG}."</b></font>&nbsp</TD></TR>";
382
  } else {
383
    $authenticated->{ERRMSG} = "";
384
  }
385
 
386
  print header(-cookie=>$PEEPSAUTH_cookie);
387
 
11 - 388
  printRCHeader("Sign In");
2 - 389
  print<<authpage;
390
  <form action="$ENV{REQUEST_URI}" method=POST name=Req id=Req>
11 - 391
    <h2>Please Sign In</h2>
2 - 392
    <TABLE>
393
    $authenticated->{ERRMSG}
394
authpage
395
 
12 - 396
  print<<firsttimer unless $query->cookie ("PEEPS_MFA_UUID");
397
    <TR><TD colspan=2>It looks like this might be your first visit to PEEPS.<br>
398
    If you had a login to MemberSuite, use the<br>
399
    <A HREF="recoverAccount">[recover your account]</A> link with either your <br>
400
    registered email address or Member ID to find<br>
401
    and link your account.</td></tr>
402
    <TR><TD colspan=2>&nbsp;</td></tr>
403
firsttimer
404
 
2 - 405
  if ($ENV{'QUERY_STRING'} eq "LOGOUT") {
406
    print "<TR><TD colspan=2>&nbsp</TD></TR>";
407
    print "<TR><TD colspan=2><button onClick=\"location.href='';\">Log In</button></TD></TR>";
408
    print "</TABLE></BODY></HTML>";
409
    exit;
410
  }
411
 
412
  if ($authenticated->{authenticated} eq "inactive") {
413
 
414
    print<<activationpage;
415
      <TR><TD colspan=2 align=center>&nbsp;</TD></TR>
416
      <TR><TD align=right><B>Activation Code:</TD><TD><INPUT type=text id=activate name=activate></TD></TR>
417
      <TR><TD></TD><TD><INPUT type=submit name=login value=Submit></TD></TR>
418
      <TR><TD colspan=2 align=center>&nbsp;</TD></TR>
419
      <TR><TD colspan=2 align=center><A HREF='' onClick='document.getElementById("activate").value="resend"; Req.submit(); return false;'>[Resend your activation email]</A></TD></TR>
420
      <TR><TD colspan=2 align=center><A HREF='' onClick="location.href='?LOGOUT';">[Log Out]</A></TD></TR>
421
      </TABLE></FORM>
422
activationpage
423
 
424
  } elsif ($authenticated->{authenticated} eq "needsMFA") {
425
 
426
    print<<MFApage;
427
      <TR><TD colspan=2 align=center>&nbsp;</TD></TR>
428
      <TR><TD align=right><B>Email Authentication Code:</TD><TD><INPUT type=text id=authenticate name=authenticate></TD></TR>
429
      <TR><TD></TD><TD><INPUT type=submit name=login value=Submit></TD></TR>
430
      <TR><TD colspan=2 align=center>&nbsp;</TD></TR>
431
      <TR><TD colspan=2 align=center>Save this browser: <label class="switch"><input name="saveMFA" type="checkbox" value="1"><span class="slider round"></span></label></TD></TR>
432
      <TR><TD colspan=2 align=center><A HREF='' onClick='document.getElementById("authenticate").value="resend"; Req.submit(); return false;'>[Send new authentication code]</A></TD></TR>
433
      <TR><TD colspan=2 align=center><A HREF='' onClick="location.href='?LOGOUT';">[Log Out]</A></TD></TR>
434
      </TABLE></FORM>
435
MFApage
436
 
437
  } else {
438
 
439
    print<<authpage2;
440
      <TR>
12 - 441
        <TD style="text-align: right;"><B>Username:</TD><TD><INPUT type=text id=login name=userid></TD>
2 - 442
      </TR>
443
      <TR>
12 - 444
        <TD style="text-align: right;"><B>Password:</TD><TD><INPUT type=password name=pass></TD>
2 - 445
      </TR>
12 - 446
      <TR><TD></TD><TD style="text-align: right;"><input type=hidden name=activate id=activate value=$FORM{'activate'}><input type=hidden name=authenticate id=authenticate value=$FORM{'authenticate'}><INPUT type=submit name=login value=Submit></TD></TR>
11 - 447
      <TR><TD colspan=2>&nbsp</TD></TR>
2 - 448
      <TR><TD colspan=2 align=center><A HREF="view_user?submit=New%20User">[register as a new user]</A></TD></TR>
449
      <TR><TD colspan=2 align=center><A HREF="recoverAccount">[recover your account]</A></TD></TR>
450
    </TABLE>
451
    </FORM>
452
 
453
    <SCRIPT language="JavaScript">
454
    <!--
455
    document.getElementById("login").focus();
456
 
457
    function Login () {
458
      document.getElementById('Req').action = "$ENV{SCRIPT_NAME}";
459
      document.getElementById('Req').submit.click();
460
      return true;
461
    }
462
 
463
    //-->
464
    </SCRIPT>
465
 
466
authpage2
467
  }
468
 
469
#foreach (keys %ENV) {
470
# print "$_: $ENV{$_}<br>";
471
#}
472
# &JScript;
473
  exit;
474
}
475
 
476
sub canView {
477
  my $A = shift // "";
478
  my $B = shift // "";
479
  # Is A a lead or higher of one of B's Depts? (or they're looking at themselves)
480
  # parameters should be a Hashref to the users' details
481
 
482
  return 1 if $A->{person_id} == $B->{person_id}; # It's the same person.
483
 
40 - 484
  my $admin_check = $ORCUSER->{SYSADMIN} + $ORCUSER->{SANCTIONING};
2 - 485
 
486
  return 1 if $admin_check or $A->{access} > 4; # viewer and target are the same person or it's a SysAdmin.
487
 
488
  my ($league_admin) = $dbh->selectrow_array ("select * from role where person_id = ? and member_org_id in (select distinct member_org_id from role where person_id = ?) and role = ?", undef, $A->{person_id}, $B->{person_id}, "League Admin");
489
 
490
  return 1 if $league_admin;
491
 
492
 
493
  return 0;
494
}
495
 
496
sub getShiftDepartment {
497
  my $shiftID = shift // "";
498
  my $dept;
499
 
500
  if ($shiftID =~ /^\d+$/) {
501
    ($dept) = $dbh->selectrow_array ("select dept from shift where id = ?", undef, $shiftID);
502
  } else {
503
    my ($id, $role) = split /-/, $shiftID;
504
    if ($role =~ /^CLA/) {
505
      $dept = "CLA";
506
    } else {
507
      ($dept) = $dbh->selectrow_array ("select distinct department from staff_template where role like ?", undef, $role.'%');
508
    }
509
  }
510
#  } elsif ($shiftID =~ /^\d+-ANN/) {
511
#    $dept = "ANN";
512
#  } else {
513
#    $dept = "OFF";
514
#  }
515
 
516
  return $dept;
517
}
518
 
519
sub getClassID {
520
  my $shift = shift // "";
521
  return unless $shift =~ /^\d+$/;
522
 
523
  my $shiftref = getShiftRef ($shift);
524
  my ($classid) = $dbh->selectrow_array ("select id from class where date = ? and start_time = ? and location = ?", undef, $shiftref->{date}, $shiftref->{start_time}, $shiftref->{location});
525
  return $classid unless !$classid;
526
 
527
  warn "ERROR: No class.id found for shift $shiftref->{id}";
528
  return "";
529
}
530
 
531
sub getShiftRef {
532
  my $shiftID = shift // "";
533
  return unless $shiftID =~ /^\d+$/;
534
 
535
  my ($shiftref) = $dbh->selectrow_hashref ("select * from shift where id = ?", undef, $shiftID);
536
  return $shiftref unless $shiftref->{id} != $shiftID;
537
 
538
  warn "ERROR: Couldn't find shift with ID [$shiftID]";
539
  return "";
540
}
541
 
542
sub getLeagueAffiliation {
543
  my $PEEPSid = shift // "";
544
 
545
  my $results;
546
 
547
  my $sth = $dbh->prepare ("select member_org_id, league_name, role, type from role join organization on member_org_id = organization.id left join person on person_id = person.id where person_id = ?");
548
  if ($PEEPSid =~ /^\d+$/) {
549
    $sth->execute ($PEEPSid);
550
    while (my ($orgid, $orgname, $role, $orgtype) = $sth->fetchrow_array ()) {
551
      push (@{$results->{$orgid}}, $role);
552
    }
553
  }
554
  return $results;
555
}
556
 
557
sub getLeagueName {
558
  my $id = shift // "";
559
  my ($name) = $dbh->selectrow_array ("select league_name from organization where id = ?", undef, $id);
560
  return $name;
561
}
562
 
31 - 563
sub getLeague {
564
  my $id = shift // "";
565
  my ($league) = $dbh->selectrow_hashref ("select * from organization where id = ?", undef, $id);
566
  return $league;
567
}
568
 
2 - 569
sub getLeagues {
570
  my $exclude_id = shift // 0;
16 - 571
  return $dbh->selectall_arrayref ("select id, concat_ws(' - ', league_name, type, status) as league from organization where status in ('Active', 'Voluntary Inactive') and visible = 1 and id not in (select member_org_id from role where person_id = ?) order by league_name", undef, $exclude_id);
2 - 572
}
573
 
574
sub getDepartments {
575
  my $RCid = shift // "";
576
  # If we get an RCid, return the list of departments and levels for that user.
577
  #   Otherwise (no parameter), return the list of departments with their display names.
578
 
579
  if ($RCid) {
580
    my $sth = $dbh->prepare("select department from official where RCid = ?");
581
    $sth->execute($RCid);
582
    my ($dlist) = $sth->fetchrow;
583
    return convertDepartments ($dlist);
584
  } else {
585
    my %HASH;
586
    my $sth = $dbh->prepare("select TLA, name from department");
587
    $sth->execute();
588
    while (my ($tla, $name) = $sth->fetchrow) {
589
      $HASH{$tla} = $name;
590
    }
591
    return \%HASH;
592
  }
593
 
594
}
595
 
596
sub convertDepartments {
597
  # For the department membership, converts the DB string back and forth to a hashref...
598
  my $input = shift // "";
599
  my $output;
600
 
601
  if (ref $input eq "HASH") {
602
    $output = join ":", map { $_."-".$input->{$_} } sort keys %{$input};
603
  } else {
604
    foreach (split /:/, $input) {
605
      my ($tla, $level) = split /-/;
606
      $output->{$tla} = $level;
607
    }
608
    $output = {} unless ref $output eq "HASH";
609
  }
610
 
611
  return $output;
612
}
613
 
614
sub getPolicyByID {
615
  my $pid = shift // "";
616
 
22 - 617
  (warn "ERROR: No PolicyID passed to getPolicyByID()" and return {}) unless $pid =~ /^\d+$/;
2 - 618
 
619
  my $policy = $dbh->selectrow_hashref ("select * from policy where id = ?", undef, $pid);
620
 
22 - 621
  (warn "ERROR: No Policy found with id: $pid" and return {}) unless $policy->{id} eq $pid;
2 - 622
 
623
  return $policy;
624
}
625
 
626
sub getCoverageByID {
627
  my $pid = shift // "";
628
  my $person = shift // "";
629
 
630
  (warn "ERROR: No PolicyID passed to getCoverageByID()" and return) unless $pid    =~ /^\d+$/;
631
  (warn "ERROR: No PersonID passed to getCoverageByID()" and return) unless $person =~ /^\d+$/;
632
 
633
  my $policy = $dbh->selectrow_hashref ("select * from coverage where id = ? and person_id = ?", undef, $pid, $person);
634
 
635
  (warn "ERROR: No Coverage found with id: $pid and person_id: $person" and return) unless $policy->{id} =~ /^\d+$/;
636
 
637
  return $policy;
638
}
639
 
29 - 640
sub getOrgCoverageByID {
641
  my $pid = shift // "";
642
  my $leagueid = shift // "";
643
 
644
  (warn "ERROR: No PolicyID passed to getOrgCoverageByID()" and return) unless $pid    =~ /^\d+$/;
645
  (warn "ERROR: No LeagueID passed to getOrgCoverageByID()" and return) unless $leagueid =~ /^\d+$/;
646
 
647
  my $policy = $dbh->selectrow_hashref ("select * from org_coverage where id = ? and organization_id = ?", undef, $pid, $leagueid);
648
 
649
  (warn "ERROR: No Coverage found with id: $pid" and return) unless $policy->{id} =~ /^\d+$/;
650
 
651
  return $policy;
652
}
653
 
2 - 654
sub convertTime {
655
  my $time = shift || return;
656
 
657
  if ($time =~ / - /) {
658
    return join " - ", map { convertTime ($_) } split / - /, $time;
659
  }
660
 
661
  $time =~ s/^(\d{1,2}:\d{2}):\d{2}$/$1/;
662
  $time =~ s/^0//;
663
 
664
  if ($ORCUSER->{timeformat} eq "24hr") {
665
    if ($time =~ /^\d{1,2}:\d{2}$/) { return $time; }
666
  } else {
667
    my ($hr, $min) = split /:/, $time;
668
    my $ampm = " am";
669
    if ($hr >= 12) {
670
      $hr -= 12 unless $hr == 12;
671
      $ampm = " pm";
672
    } elsif ($hr == 0) {
673
      $hr = 12;
674
    }
675
    return $hr.":".$min.$ampm;
676
  }
677
}
678
 
679
sub getSchedule {
680
  my $RCid = shift // return "ERROR: No RCid provided to getSchedule";
681
  my $filter = shift // "";
682
  my $output = shift // "";
683
  my $year = 1900 + (localtime)[5];
684
 
685
  my @whereclause;
686
  if ($filter eq "all") {
687
    push @whereclause, "year(date) >= year(now())";
688
  } elsif ($filter eq "prior") {
689
    push @whereclause, "year(date) < year(now())";
690
  } else {
691
    push @whereclause, "date >= date(now())";
692
  }
693
#  if ($RCid ne $ORCUSER->{RCid}) {
694
#    push @whereclause, "dept != 'PER'";
695
#  }
696
 
697
  use DateTime;
698
  my $dt = DateTime->today (time_zone => 'America/Los_Angeles');
699
  $dt =~ s/T00\:00\:00$//;
700
  my $now = DateTime->now (time_zone => 'America/Los_Angeles');
701
 
702
 
703
  use HTML::Tiny;
704
  my $h = HTML::Tiny->new( mode => 'html' );
705
 
706
  my $where = scalar @whereclause ? "where ".join " and ", @whereclause : "";
707
  my @shifts;
708
  my $sth = $dbh->prepare("select * from (select id, date, dayofweek, track as location, time, role, teams, signup, 'OFF' as dept, volhours from v_shift_officiating where RCid = ? union
709
                                          select id, date, dayofweek, track as location, time, role, teams, signup, 'ANN' as dept, volhours from v_shift_announcer where RCid = ? union
710
                                          select id, date, dayofweek, location, time, role, '' as teams, type as signup, dept, volhours from v_shift where RCid = ? union
711
                                          select id, date, dayofweek, location, time, role, name as teams, 'mvpclass' as signup, 'CLA' as dept, 0 as volhours from v_class_signup_new where RCid = ?) temp
712
                           $where order by date, time");
713
  $sth->execute($RCid, $RCid, $RCid, $RCid);
714
  my $hours = 0;
715
  while (my $s = $sth->fetchrow_hashref) {
716
    my ($yyyy, $mm, $dd) = split /\-/, $s->{date};
717
    my $cutoff = DateTime->new(
718
        year => $yyyy,
719
        month => $mm,
720
        day => $dd,
721
        hour => 5,
722
        minute => 0,
723
        second => 0,
724
        time_zone => 'America/Los_Angeles'
725
    );
726
 
727
 
728
    if (!$s->{teams} or $s->{dept} eq "CLA") {
729
      # it's a time-based shift
730
      if ($s->{dept} eq "PER") {
731
        if ($RCid eq $ORCUSER->{RCid}) {
732
          # DROP
733
          $s->{buttons} = $h->button ({ onClick=>"event.stopPropagation(); if (confirm('Really? You want to delete this personal time?')==true) { location.href='personal_time?choice=Delete&id=$s->{id}'; return false; }" }, "DEL")."&nbsp;".$h->button ({ onClick=>"event.stopPropagation(); location.href='personal_time?choice=Update&id=$s->{id}'" }, "EDIT");
734
        } else {
735
          $s->{location} = "";
736
          $s->{role} = "";
737
        }
738
      } elsif (($RCid == $ORCUSER->{RCid} and $s->{signup} !~ /^selected/ and $now < $cutoff) or ($ORCUSER->{department}->{$s->{dept}} >= 2 or $ORCUSER->{access} >= 5)) {
739
        # DROP
740
        my ($shiftORclass, $linkargs) = ("shift", "");
741
        if ($s->{dept} eq "CLA") {
742
          $shiftORclass = "class";
743
          $linkargs = "&role=$s->{role}";
744
          $s->{role} = $s->{teams};
745
          $s->{teams} = "";
746
        }
747
        $s->{buttons} = $h->button ({ onClick=>"if (confirm('Really? You want to drop this $shiftORclass?')==true) { window.open('make_shift_change?change=del&RCid=$RCid&id=$s->{id}$linkargs','Confirm Class Change','resizable,height=260,width=370'); return false; }" }, "DROP");
748
        if ($ORCUSER->{department}->{$s->{dept}} >= 2 or $ORCUSER->{access} >= 5) {
749
          # NO SHOW
750
          $s->{buttons} .= "&nbsp;".$h->button ({ onClick=>"if (confirm('Really? They were a no show?')==true) { window.open('make_shift_change?noshow=true&change=del&RCid=$RCid&id=$s->{id}$linkargs','Confirm Shift Change','resizable,height=260,width=370'); return false; }" }, "NO SHOW");
751
        }
752
 
753
      }
754
#     $hours += $s->{volhours} unless $s->{dept} eq "PER" or $s->{dept} eq "CLA";
755
 
756
    } elsif (($RCid == $ORCUSER->{RCid} and $s->{signup} !~ /^selected/ and $now < $cutoff) or ($ORCUSER->{department}->{$s->{dept}} >= 2 or $ORCUSER->{access} >= 5)) {
757
      # it's a game shift
758
      #DROP
759
      $s->{buttons} = $h->button ({ onClick=>"if (confirm('Really? You want to drop this shift?')==true) { window.open('make_shift_change?change=del&RCid=$RCid&id=$s->{id}&role=$s->{role}','Confirm Shift Change','resizable,height=260,width=370'); return false; }" }, "DROP");
760
      if ($ORCUSER->{department}->{$s->{dept}} >= 2 or $ORCUSER->{access} >= 5) {
761
        # NO SHOW
762
        $s->{buttons} .= "&nbsp;".$h->button ({ onClick=>"if (confirm('Really? They were a no show?')==true) { window.open('make_shift_change?noshow=true&change=del&RCid=$RCid&id=$s->{id}&role=$s->{role}','Confirm Shift Change','resizable,height=260,width=370'); return false; }" }, "NO SHOW");
763
      }
764
#      $hours += $s->{volhours};
765
    }
766
    $s->{role} =~ s/\-\d+$//;
767
 
768
#   push @shifts, $h->li ({ class=> $s->{date} eq $dt ? "nowrap highlighted" : "nowrap shaded" }, join '&nbsp;&nbsp;', $s->{date}, $s->{dayofweek}, $s->{time}, $s->{location}, getDepartments()->{$s->{dept}}, $s->{role}, $s->{teams}, $s->{buttons});
769
#   push @shifts, $h->li ({ class=> $s->{date} eq $dt ? "highlighted" : "shaded" }, join '&nbsp;&nbsp;', $s->{date}, $s->{dayofweek}, $s->{time}, $s->{location}, getDepartments()->{$s->{dept}}, $s->{role}, $s->{teams}, $s->{buttons});
770
    $s->{time} = convertTime $s->{time};
771
    if ($s->{dept} eq "PER") {
772
      push @shifts, $h->li ({ onClick => "location.replace('personal_time?id=$s->{id}');", class=> $s->{date} eq $dt ? "highlighted" : "shaded" }, $h->div ({ class=>"lisp0" }, [ $h->div ({ class=>"liLeft" }, join '&nbsp;&nbsp;', ($s->{date}, $s->{dayofweek}, $s->{time}, $s->{location}, $s->{dept} eq "CLA" ? "MVP Class:" : getDepartments()->{$s->{dept}}, $s->{role}, $s->{teams})), $h->div ({ class=>"liRight" }, $s->{buttons}) ]));
773
    } else {
774
      push @shifts, $h->li ({ class=> $s->{date} eq $dt ? "highlighted" : "shaded" }, $h->div ({ class=>"lisp0" }, [ $h->div ({ class=>"liLeft" }, join '&nbsp;&nbsp;', ($s->{date}, $s->{dayofweek}, $s->{time}, $s->{location}, $s->{dept} eq "CLA" ? "MVP Class:" : getDepartments()->{$s->{dept}}, $s->{role}, $s->{teams})), $h->div ({ class=>"liRight" }, $s->{buttons}) ]));
775
    }
776
    $hours += $s->{volhours} unless $s->{dept} eq "PER" or $s->{dept} eq "CLA";
777
  }
778
 
779
  if ($output eq "hours") {
780
    return $hours;
781
  }
782
 
783
  if (scalar @shifts) {
784
    return $h->ul ([ @shifts, $h->h5 ("Currently showing $hours hours of Volunteer Time.") ]);
785
  } elsif ($filter eq "prior") {
786
    return $h->p ({ class=>"hint" }, "[nothing to see here]");
787
  } else {
788
    return $h->p ({ class=>"hint" }, "[nothing scheduled at the moment]");
789
  }
790
}
791
 
792
sub getRCid {
793
  my $derbyname = shift;
794
  ($derbyname) = $dbh->selectrow_array ("select RCid from official where derby_name = ?", undef, $derbyname);
795
  return $derbyname;
796
}
797
 
798
sub getSetting {
799
  my $k = shift;
800
 
801
  my ($value) = $dbh->selectrow_array ("select setting.value from setting where setting.key = ?", undef, $k);
802
  return defined $value ? $value : undef;
803
}
804
 
805
sub getUser {
806
  my $ID = shift;
807
 
808
  my $sth;
809
  if ($ID =~ /^\d+$/) {
810
    $sth = $dbh->prepare("select * from person where id = ?");
811
  } elsif ($ID =~ /@/) {
812
    $sth = $dbh->prepare("select * from person where email = ?");
813
  } else {
814
    $sth = $dbh->prepare("select * from person where id = (select person_id from authentication where username = ?)");
815
  }
816
  $sth->execute($ID);
817
  my $user = $sth->fetchrow_hashref;
818
 
819
  my $auth = $dbh->selectrow_hashref ("select * from authentication where person_id = ?", undef, $user->{id});
820
 
821
  map { $user->{$_} = "" unless $user->{$_} } keys %{$user};
822
  map { $user->{$_} = $auth->{$_} ? $auth->{$_} : "" } keys %{$auth};
823
  $user->{person_id} = $user->{id};
824
  return $user->{id} ? $user : "";
825
}
826
 
827
sub getUserEmail {
828
  my $RCid = shift;
829
  my $sth = $dbh->prepare("select email from official where RCid = ?");
830
  $sth->execute($RCid);
831
  my ($email) = $sth->fetchrow_array();
832
  return $email;
833
}
834
 
835
sub getUserDerbyName {
836
  my $RCid = shift;
837
  my $sth = $dbh->prepare("select derby_name from official where RCid = ?");
838
  $sth->execute($RCid);
839
  my ($dname) = $sth->fetchrow_array();
840
  return $dname;
841
}
842
 
843
sub getYears {
844
  my $sth = $dbh->prepare("select distinct year from (select distinct year(date) as year from shift union select distinct year(date) as year from game union select distinct year(date) as year from class union select year(now()) as year) years order by year");
845
# my $sth = $dbh->prepare("select distinct year(date) from v_shift_admin_view");
846
  $sth->execute();
847
  my @years;
848
  while (my ($y) =$sth->fetchrow_array()) { push @years, $y; }
849
  return \@years;
850
}
851
 
852
sub printRCHeader {
853
  my $PAGE_TITLE = shift;
854
  my $redirect = shift // "";
855
# use CGI qw/start_html/;
856
  use HTML::Tiny;
857
  my $h = HTML::Tiny->new( mode => 'html' );
4 - 858
  $ENV{HTTPS} = 'ON' if $ENV{SERVER_NAME} =~ /^peeps/;
2 - 859
 
860
#  my $logout = $h->a ({ href=>"index", onClick=>"document.cookie = 'PEEPSAUTH=; expires=Thu, 01 Jan 1970 00:00:01 GMT; path=/';return true;" }, "[Log Out]");
861
  my $referrer = param ("referrer") ? param ("referrer") : $ENV{HTTP_REFERER};
862
  my $logout = (!$referrer or $referrer eq url) ? "" : $h->button ({ onClick=>"window.location.href='$referrer';" }, "Back")."&nbsp;";
863
  $logout .= url =~ /\/(index)?$/ ? "" : $h->button ({ onClick=>"window.location.href='/';" }, "Home")."&nbsp;";
864
#  $logout .= $h->button ({ onClick=>"document.cookie = 'PEEPSAUTH=; expires=Thu, 01 Jan 1970 00:00:01 GMT; path=/'; location.href='/';" }, "Log Out");
865
  $logout .= $h->button ({ onClick=>"location.href='?LOGOUT';" }, "Log Out");
866
 
867
  my $loggedinas = $ORCUSER ? "Currently logged in as: ".$h->a ({ href=>"/view_user?submit=View&person_id=$ORCUSER->{person_id}" }, $ORCUSER->{derby_name}).$h->br.$logout : "";
868
 
869
#  print start_html (-title=>"vORC - $PAGE_TITLE", -style => {'src' => "/style.css"} );
870
 
871
  my $ANALYTICS = <<MATOMO;
872
  var _mtm = window._mtm = window._mtm || [];
873
  _mtm.push({'mtm.startTime': (new Date().getTime()), 'event': 'mtm.Start'});
874
  (function() {
875
    var d=document, g=d.createElement('script'), s=d.getElementsByTagName('script')[0];
876
    g.async=true; g.src='https://analytics.whump.org/js/container_to4NCtvM.js'; s.parentNode.insertBefore(g,s);
877
  })();
878
MATOMO
879
 
880
  print $h->open ("html");
881
  print $h->head ([$h->title ("PEEPS - $PAGE_TITLE"),
882
                   $h->link  ({ rel  => "stylesheet",
883
                                type => "text/css",
884
                                href => "/style.css" }),
885
                   $redirect ? $h->meta ({ 'http-equiv'=>"refresh", content=>"0; URL=".$redirect }) : "",
886
#                   $h->script ($ANALYTICS)
887
                  ]);
888
  print $h->open ("body");
889
#  print $h->img ({referrerpolicy=>"no-referrer-when-downgrade", src=>"https://analytics.whump.org/matomo.php?idsite=2&amp;rec=1", style=>"border:0", alt=>""});
890
#<html><head><title>Officials' RollerCon Schedule Manager - $PAGE_TITLE</title>
891
#<link rel="stylesheet" type="text/css" href="/style.css">
892
#</head>
893
#<body text="#000000" bgcolor="#FFFFFF" link="#0000EE" vlink="#551A8B" alink="#FF0000">
11 - 894
  print $h->div ({ class=>"sp0" }, [ $h->div ({ class=>"spLeft" },  $h->a ({ href=>"/" }, $h->img ({ src=>"/images/wftdapeeps-powerby-wftdainsurance-2.svg", width=>"400", height=>"75" }))),
895
                                     $h->div ({ class=>"spRight" }, [ $h->h1 (["$PAGE_TITLE", $h->br]),
2 - 896
                                     $loggedinas,
897
                                     ])
898
                                   ]);
899
#print<<rcheader;
900
#  <TABLE>
901
# <TR class="nostripe">
902
#   <TD align=right><img SRC="/logo.jpg"></TD>
903
#   <TD align=center valign=middle><b><font size=+3>Officials' RollerCon<br>Schedule Manager<br>$PAGE_TITLE</FONT></b>
904
# <p align=right><font size=-2>$loggedinas <a href='index' onClick="document.cookie = 'PEEPSAUTH=; expires=Thu, 01 Jan 1970 00:00:01 GMT; path=/';return true;">[Log Out]</a></font></TD>
905
# </TR>
906
 
907
#rcheader
908
}
909
 
910
sub changeShift {
911
  my ($change, $shift_id, $role, $user_id) = @_;
912
  if ($shift_id =~ /(am|pm)/) {
913
    my ($td, $st, $tl) = split /\|/, $shift_id;
914
    my ($hr, $min, $ampm) = split /:|\s/, $st;
915
    if ($ampm eq "pm") { $hr += 12; }
916
    elsif ($ampm eq "am" and $hr == 12) { $hr = "00" }
917
 
918
    $st = $hr.":".$min;
919
    $shift_id = join "|", ($td, $st, $tl);
920
  } else {
921
    $shift_id =~ s/(\d+:\d+):00/$1/;
922
  }
923
#warn join " - ", $change, $shift_id, $role, $user_id;
924
  my $leadership_change = 0;
925
# my $department = getShiftDepartment ($role ? $shift_id."-".$role : $shift_id);
926
  my $department;
927
  if ($shift_id =~ /^\d+$/) {
928
    $department = getShiftDepartment ($role ? $shift_id."-".$role : $shift_id);
929
  } else {
930
    $department = "CLA";
931
    if ($change eq "del") {
932
      ($shift_id, $role) = $dbh->selectrow_array ("select id, role from v_class_signup_new where date = ? and start_time = ? and location = ?", undef, split /\|/, $shift_id);
933
    } else {
934
      if ($change eq "override") {
935
        ($shift_id, $role) = $dbh->selectrow_array ("select id, concat('CLA-', max(cast(substring_index(role, '-', -1) as UNSIGNED)) +1) as role from v_class_signup_new where date = ? and start_time = ? and location = ?", undef, split /\|/, $shift_id) unless $change ne "override";
936
      } else {
937
        ($shift_id, $role) = $dbh->selectrow_array ("select id, concat('CLA-', max(cast(substring_index(role, '-', -1) as UNSIGNED)) +1) as role, count(role), capacity from v_class_signup_new where date = ? and start_time = ? and location = ? having capacity > count(role)", undef, split /\|/, $shift_id);
938
      }
939
    }
940
    $role = "CLA-1" unless $role; # If no one has signed up for the class yet, the SQL above doesn't retrieve the first available
941
  }
942
# my $game_based = $role ? "game" : "shift";
943
  my $game_based = $role =~ /^CLA-/ ? "class" : $role ? "game" : "shift";
944
  my $sth;
945
 
946
  if ($change eq "add" or $change eq "override") {
947
    my $taken;
948
    if ($department eq "CLA") {
949
      ($taken) = $shift_id ? 0 : 1;
950
    } elsif ($game_based eq "game") {
951
      ($taken) = $dbh->selectrow_array ("select count(*) from assignment where Gid = ? and role = ?", undef, $shift_id, $role);
952
    } else {
953
      ($taken) = $dbh->selectrow_array ('select count(*) from shift where id = ? and (isnull(assignee_id) = 0 or assignee_id <> "")', undef, $shift_id);
954
    }
955
    if ($taken) {
956
      return ($department eq "CLA") ? "<br>Denied! This class is already full ($shift_id).<br>\n" : "<br>Denied! This shift is already taken ($shift_id).<br>\n";
957
    }
958
  }
959
 
960
  if (lc ($user_id) ne lc ($ORCUSER->{RCid})) { # they're changing someone else's schedule...
961
    if (($department eq "CLA" and $ORCUSER->{department}->{MVP} >= 2) or $ORCUSER->{department}->{$department} >= 2 or $ORCUSER->{access} >= 5 or $ORCUSER->{department}->{VCI} >= 2) {
962
      # the user making the change is either a lead in the dept, a sysadmin, or a VCI lead
963
      logit ($ORCUSER->{RCid}, "$ORCUSER->{derby_name} changed someone else's schedule. ($change, $shift_id, $role, $user_id)");
964
      logit ($user_id, "Schedule was changed by $ORCUSER->{derby_name}. ($change, $shift_id, $role, $user_id)");
965
      $leadership_change = 1;
966
    } else {
967
      logit ($ORCUSER->{RCid}, "Unauthorized attempt to change someone else's schedule. ($change, $shift_id, $role, $user_id)");
968
      return "<br>Denied! You are not authorized to change someone else's schedule in this department ($department).<br>\n";
969
    }
970
  } elsif ($ORCUSER->{department}->{$department} >= 3 or $ORCUSER->{access} >= 5) {
971
    # Managers can sign up for as many shifts within their own department as they like...
972
    $leadership_change = 1;
973
  }
974
 
975
  if ($change eq "add") {
976
    if ($department eq "CLA" and !getUser($user_id)->{MVPid}) {
977
      return "<br>Denied! User ($user_id) does not have an MVP Pass!<br>\n";
978
    } elsif ($department ne "CLA" and getUser($user_id)->{department} and convertDepartments(getUser($user_id)->{department})->{$department} < 1) {
979
      return "<br>Denied! User ($user_id) is not a member of Department ($department)!<br>\n" unless $department eq "CMP";
980
    } elsif ($department eq "EMT" and getUser($user_id)->{emt_verified} == 0) {
981
      return "<br>Denied! User ($user_id) has not had their EMT status verified!<br>\n";
982
    }
983
  }
984
 
985
  my $conflict = findConflict ($user_id, $shift_id, $game_based);
986
  if ($change eq "add" and $conflict) {
987
    return "<br>Denied! There is a conflict ($conflict) with that shift's time!<br>\n";
988
  }
989
 
990
  my $game_type;
991
  if ($department ne "CLA") {
992
    ($game_type) = $dbh->selectrow_array ("select type from ".$game_based." where id = ?", undef, $shift_id);
993
 
994
    if ($game_type =~ /^selected/ and !$leadership_change) {
995
      return "<br>Denied! Only leadership can make changes to 'selected staffing' shifts!<br>\n" unless $department eq "CMP";
996
    }
997
 
998
    if ($change eq "add" and $game_type eq "lead" and convertDepartments(getUser($user_id)->{department})->{$department} < 2 and $ORCUSER->{access} < 3) {
999
      return "<br>Denied! Shift reserved for leadership staff!<br>\n";
1000
    }
1001
  } else {
1002
    $game_type = "class";
1003
  }
1004
 
1005
 
1006
#   my $MAXSHIFTS = getSetting ("MAX_SHIFT_SIGNUP_PER_DAY");
1007
  my $MAXSHIFTS = getSetting ("MAX_SHIFT_SIGNUP_PER_DAY_".$department);
1008
  $MAXSHIFTS = getSetting ("MAX_SHIFT_SIGNUP_PER_DAY") unless defined $MAXSHIFTS;
1009
  if ($game_type eq "lead" and $department eq "OFF") { $MAXSHIFTS = 99; }
1010
 
1011
  my $daily_count;
1012
  if ($department eq "CLA") {
1013
    # MVP Class Sign-up
1014
    $MAXSHIFTS = getSetting ("MAX_CLASS_SIGNUP");
1015
    ($daily_count) = $dbh->selectrow_array ("select count(*) from v_class_signup_new where RCid = ? and year(date) = year(now())", undef, $user_id);
1016
#   ($daily_count) = $dbh->selectrow_array ("select count(*) from v_shift where RCid = ? and dept = 'CLA'", undef, $user_id);
1017
    if ($change eq "add" and $daily_count >= $MAXSHIFTS and !$leadership_change) {
1018
      return "<br>Denied! You may only sign up for $MAXSHIFTS Classes!<br>\n";
1019
    }
1020
  } else {
1021
    $daily_count = signUpCount ('get', $user_id, $department);
1022
    if ($change eq "add" and $daily_count >= $MAXSHIFTS and !$leadership_change) {
1023
      return "<br>Denied! You may only sign up for $MAXSHIFTS $game_type shifts in one day!<br>\n";
1024
    }
1025
    if ($change eq "add" and $game_based eq "game" and ($department eq "OFF" or $department eq "ANN") and $game_type eq "full length" and !$leadership_change) {
1026
      my $dept_table = $department eq 'OFF' ? "v_shift_officiating" : "v_shift_announcer";
1027
      my ($full_length_count) = $dbh->selectrow_array ("select count(*) from $dept_table where RCid = ? and gtype = 'full length' and year(date) = year(now())", undef, $user_id);
1028
      my $full_length_max = getSetting("MAX_FULL_LENGTH_SIGNUP_".$department);
1029
      if ($full_length_count >= $full_length_max) {
1030
        my $errormsg = "<br>Denied! You may only sign up to ".($department eq 'OFF' ? "officiate" : "announce")." $full_length_max $game_type game(s) (total)!<br>\n";
1031
        return $errormsg;
1032
      }
1033
    }
1034
  }
1035
 
1036
  my @DBARGS;
1037
  if ($game_based eq "game" or $game_based eq "class") {
1038
    if ($change eq "add" or $change eq "override") {
1039
      $sth = $dbh->prepare("insert into assignment (Gid, role, RCid) values (?, ?, ?)");
1040
    } elsif ($change eq "del") {
1041
      $sth = $dbh->prepare("delete from assignment where Gid = ? and role = ? and RCid= ?");
1042
    }
1043
    @DBARGS = ($shift_id, $role, $user_id);
1044
  } else {
1045
    if ($change eq "add" or $change eq "override") {
1046
      $sth = $dbh->prepare("update shift set assignee_id = ? where id = ? and isnull(assignee_id) = 1");
1047
      @DBARGS = ($user_id, $shift_id);
1048
    } elsif ($change eq "del") {
1049
      $sth = $dbh->prepare("update shift set assignee_id = null where id = ?");
1050
      @DBARGS = ($shift_id);
1051
    }
1052
  }
1053
 
1054
  my $wb_act_code;
1055
  if ($change eq "del" and $department eq "CLA") {
1056
    ($wb_act_code) = $dbh->selectrow_array ("select wb_ticket_act from assignment where Gid = ? and RCid = ? and role like ?", undef, $DBARGS[0], $DBARGS[2], 'CLA-%');
1057
  }
1058
 
1059
  print "<br>attempting to make DB changes...<br>";
1060
  if ($sth->execute (@DBARGS)) {
1061
    $daily_count = signUpCount ($change, $user_id, $department) unless $leadership_change;
1062
    logit ($user_id, "Shift ".ucfirst($change).": $shift_id -> $role");
1063
    logit ($ORCUSER->{RCid}, "OVERRIDE: Shift ".ucfirst($change).": $shift_id -> $role") if $change eq "override";
1064
    if ($department eq "CLA") {
1065
      print "Success!...<br>You've signed up for $daily_count class(es) (you're currently allowed to sign up for $MAXSHIFTS).<br>\n";
1066
      updateWRSTBND ($change, $wb_act_code, $DBARGS[0], $DBARGS[2]);
1067
    } else {
1068
      print "Success!...<br>You've signed up for $daily_count shifts today (you're currently allowed to sign up for $MAXSHIFTS per day).<br>\n";
1069
    }
1070
    return;
1071
  } else {
1072
    if ($department eq "CLA") {
1073
      return "<br><b>You did not get the class</b>, most likely because it filled up while you were looking.<br>\nERROR: ", $sth->errstr();
1074
    } else {
1075
      return "<br><b>You did not get the shift</b>, most likely because someone else took it while you were looking.<br>\nERROR: ", $sth->errstr();
1076
    }
1077
  }
1078
}
1079
 
1080
sub updateWRSTBND {
1081
  my ($change, $wb_act_code, $shift_id, $user_id) = @_;
1082
  use REST::Client;
1083
  use JSON;
1084
  my $headers = { Authorization => getSetting ("WRSTBND_API_KEY") };
1085
  my $client = REST::Client->new();
1086
  $client->setHost('https://core.wrstbnd.io');
1087
 
1088
  my ($accountid) = $dbh->selectrow_array ("select wrstbnd_accountid from RCid_ticket_link left join ticket on MVPid = id where RCid = ? and year = year(now())", undef, $user_id);
1089
 
1090
  if ($change eq "add" or $change eq "override") {
1091
    my ($classid) = $dbh->selectrow_array ("select wrstbnd_id from class where id = ?", undef, $shift_id);
1092
 
1093
    my $body = {
1094
      "eventId"      => "event_893C6u5olU",
1095
      "activeStatus" => "active",
1096
      "ticketTypeId" => $classid
1097
    };
1098
    my $json_body = encode_json $body;
1099
 
1100
    $client->POST(
1101
      '/rest/core/v1/ticket',
1102
      $json_body,
1103
      $headers
1104
    );
1105
    my $response = from_json($client->responseContent());
1106
 
1107
    my $activationCode = $response->{activationCode};
1108
 
1109
    my $api_key = getSetting ("WRSTBND_API_KEY");
1110
    my @add_response = `/bin/curl --location --request POST 'https://core.wrstbnd.io/rest/core/v1/assign' --header 'Authorization: $api_key' --form accountid=$accountid --form ticketactcode=$activationCode --output /dev/null --silent --write-out '%{http_code}\n'`;
1111
    my $add_response = $add_response[$#add_response];
1112
    chomp $add_response;
1113
 
1114
    $dbh->do ("update assignment set wb_ticket_act = ? where Gid = ? and RCid = ? and role like ?", undef, $activationCode, $shift_id, $user_id, 'CLA-%') unless $add_response ne "200";
1115
 
1116
    return;
1117
  } elsif ($change eq "del") {
1118
    my $activationCode = $wb_act_code;
1119
    my $api_key = getSetting ("WRSTBND_API_KEY");
1120
    my $del_response = `/bin/curl --location --request DELETE 'https://core.wrstbnd.io/rest/core/v1/assign' --header 'Authorization: $api_key' --form accountid=$accountid --form ticketactcode=$activationCode --output /dev/null --silent --write-out '%{http_code}\n'`;
1121
  }
1122
 
1123
}
1124
 
1125
sub modShiftTime {
1126
  my ($shift_id, $user_id, $diff) = @_;
1127
  my $ORCUSER = getUser (1);
1128
 
1129
  use Scalar::Util qw(looks_like_number);
1130
  if (!looks_like_number ($diff)) {
1131
    print "<br>ERROR! The time adjustment ($diff) doesn't look like a number.<br>\n";
1132
    return;
1133
  }
1134
 
1135
  my ($validate_assignee) = $dbh->selectrow_array ("select count(*) from v_shift where id = ? and RCid = ?", undef, $shift_id, $user_id);
1136
  if (!$validate_assignee) {
1137
    print "<br>ERROR! This shift is assigned to someone else.<br>\n";
1138
    return;
1139
  }
1140
 
1141
  my $department = getShiftDepartment ($shift_id);
1142
  if (convertDepartments ($ORCUSER->{department})->{$department} < 2 and $ORCUSER->{access} < 5) {
1143
    print "<br>ERROR! You're not authorized to modify this shift's time.<br>\n";
1144
    logit ($ORCUSER->{RCid}, "Unauthorized attempt to modify shift time. ($department, $shift_id)");
1145
    return;
1146
  }
1147
 
1148
  my $rows_changed;
1149
  print "<br>attempting to make DB changes...<br>";
1150
  if ($diff == 0) {
1151
    $rows_changed = $dbh->do ("update shift set mod_time = null where id = ? and assignee_id = ?", undef, $shift_id, $user_id);
1152
  } else {
1153
    $rows_changed = $dbh->do ("update shift set mod_time = ? where id = ? and assignee_id = ?", undef, $diff, $shift_id, $user_id);
1154
  }
1155
 
1156
 
1157
  if (!$rows_changed or $dbh->errstr) {
1158
    print "ERROR: Nothing got updated".$dbh->errstr;
1159
    logit (0, "ERROR modifying a shift time ($diff, $shift_id, $user_id):".$dbh->errstr);
1160
  } else {
1161
    print "SUCCESS: Shift $shift_id succesfully modified by $diff hour(s)";
1162
    logit ($ORCUSER->{RCid}, "SUCCESS: Shift $shift_id succesfully modified by $diff hour(s)");
1163
 
1164
  }
1165
  return;
1166
}
1167
 
1168
sub signUpCount {
1169
  my $action = shift;
1170
  my $id = shift;
1171
  my $dept = shift // "";
1172
 
1173
  if ($id eq $ORCUSER->{RCid}) {
1174
    if ($action eq 'add') {
1175
      if (signUpCount ('get', $id, $dept)) {
1176
        $dbh->do("update sign_up_count set sign_ups = sign_ups + 1 where date = curdate() and RCid = ? and department = ?", undef, $id, $dept);
1177
      } else {
1178
        $dbh->do("replace into sign_up_count (date, RCid, department, sign_ups) values (curdate(), ?, ?, 1)", undef, $id, $dept);
1179
      }
1180
    } elsif ($action eq 'del') {
1181
      if (signUpCount ('get', $id, $dept)) {
1182
        $dbh->do("update sign_up_count set sign_ups = sign_ups - 1 where date = curdate() and RCid = ? and department = ?", undef, $id, $dept);
1183
      }
1184
    }
1185
  }
1186
 
1187
  my ($R) = $dbh->selectrow_array ("select sign_ups from sign_up_count where RCid = ? and department = ? and date = curdate()", undef, $id, $dept);
1188
 
1189
  return $R ? $R : '0';
1190
}
1191
 
1192
sub signUpEligible {
1193
  my $user = shift;
1194
  my $t = shift;
1195
  my $shifttype = shift // "game";
1196
  my $dept = $t->{dept} // "";
1197
  my $DEPTHASH = getDepartments ();
1198
  if ($dept and !exists $DEPTHASH->{$dept}) {
1199
    my %reverso = reverse %{$DEPTHASH};
1200
    $dept = $reverso{$dept};
1201
  }
1202
 
1203
  my $limit = getSetting ("MAX_SHIFT_SIGNUP_PER_DAY_".$dept);
1204
  $limit = getSetting ("MAX_SHIFT_SIGNUP_PER_DAY") unless defined $limit;
1205
 
1206
  if (lc $t->{type} eq "lead" and $dept eq "OFF") { $limit = 99; }
1207
 
1208
  return 0 unless $limit > 0;
1209
 
1210
  my $limitkey = $dept ? "sign_ups_today_".$dept : "sign_ups_today";
1211
 
1212
  if ($shifttype eq "class") {
1213
    my $classid = $t->{id};
1214
    $t->{start_time} =~ s/^(\d+:\d+):00$/$1/;
1215
    ($t->{id}) = $dbh->selectrow_array ("select id from v_class_new where date = ? and location = ? and start_time = ?", undef, $t->{date}, $t->{location}, $t->{start_time});
1216
    $t->{dept} = "CLA";
1217
    $dept = "CLA";
1218
    $t->{type} = "open";
1219
  }
1220
 
1221
  if (findConflict ($user->{RCid}, $t->{id}, $shifttype)) { return 0; }
1222
 
1223
  if (!exists $user->{$limitkey}) {
1224
    $user->{$limitkey} = signUpCount('get', $user->{RCid}, $dept);
1225
  }
1226
 
1227
  if ($shifttype eq "game") {
1228
#    if ($t->{gtype} !~ /^selected/ and $t->{gtype} ne "short track" and $user->{$limitkey} < $limit) {
1229
    if ($t->{gtype} eq "full length" and ($dept eq "OFF" or $dept eq "ANN")) {
1230
      my $table = $dept eq "OFF" ? "v_shift_officiating" : "v_shift_announcer";
1231
      my ($full_length_count) = $dbh->selectrow_array ("select count(*) from $table where RCid = ? and gtype = 'full length' and year(date) = year(now())", undef, $user->{RCid});
1232
      if ($full_length_count >= getSetting ("MAX_FULL_LENGTH_SIGNUP_".$dept)) {
1233
        return 0;
1234
      }
1235
    }
1236
    if (lc $t->{signup} ne "selected" and $user->{$limitkey} < $limit) {
1237
      return 1;
1238
    } else {
1239
      return 0;
1240
    }
1241
  } else {
1242
    if ($dept eq "CLA") {
1243
      # MVP Class Sign-up
1244
      return 0 unless $user->{MVPid};
1245
      my $class_limit = getSetting ("MAX_CLASS_SIGNUP");
1246
      my ($class_count) = $dbh->selectrow_array ("select count(*) from v_class_signup_new where RCid = ? and year(date) = year(now())", undef, $user->{RCid});
1247
      return 0 unless $class_count < $class_limit;
1248
    } else {
1249
      if ($user->{department}->{$dept} < 1) { return 0; }
1250
    }
1251
    if (lc $t->{type} eq "lead" and $user->{department}->{$dept} < 2) { return 0; }
1252
    if (lc $t->{type} eq "manager" and $user->{department}->{$dept} < 3) { return 0; }
1253
    if ($dept eq "EMT" and $user->{emt_verified} == 0) { return 0; }
1254
    if (lc $t->{type} !~ /^selected/ and $user->{$limitkey} < $limit) {
1255
      return 1;
1256
    } else {
1257
      return 0;
1258
    }
1259
  }
1260
}
1261
 
1262
sub findConflict {
1263
  my $rcid = shift;
1264
  my $gid = shift;
1265
  my $type = shift // "";
1266
  my ($date, $start, $end, $existing, $conflicts);
1267
 
1268
  if ($type eq "game") {
1269
  # Are they already signed up for this game? (It's faster to check the two views one at a time...)
1270
#    ($conflicts) = $dbh->selectrow_array ("select count(*) from v_shift_officiating where substring_index(id, '-', 1) = ? and RCid = ?", undef, $gid, $rcid);
1271
    ($conflicts) = $dbh->selectrow_array ("select count(*) from v_shift_officiating where id = ? and RCid = ?", undef, $gid, $rcid);
1272
    if ($conflicts) { return "OFF-".$gid; } # no need to keep looking...
1273
    ($conflicts) = $dbh->selectrow_array ("select count(*) from v_shift_announcer where id = ? and RCid = ?", undef, $gid, $rcid);
1274
    if ($conflicts) { return "ANN-".$gid; } # no need to keep looking...
1275
 
1276
    ($date, $start, $end) = $dbh->selectrow_array ("select distinct date, time, end_time from game where id = ?", undef, $gid);
1277
  } elsif ($type eq "class")  {
1278
    ($conflicts) = $dbh->selectrow_array ("select count(*) from v_class_signup_new where id = ? and RCid = ?", undef, $gid, $rcid);
1279
    if ($conflicts) { return "CLA:".$gid; } # no need to keep looking...
1280
 
1281
    ($date, $start, $end) = $dbh->selectrow_array ("select distinct date, start_time, end_time from v_class_new where id = ?", undef, $gid);
1282
 
1283
  } elsif ($type eq "personal")  {
1284
    ($date, $start, $end, $existing) = @{ $gid };
1285
  } else {
1286
    ($date, $start, $end) = $dbh->selectrow_array ("select distinct date, start_time, end_time from shift where id = ?", undef, $gid);
1287
  }
1288
 
1289
  # Are they signed up for any games that would conflict with this one?
1290
#  my $sth = $dbh->prepare("select count(*) from v_shift_admin_view where id in (select id from game where date = (select date from game where id = ?) and ((time <= (select time from game where id = ?) and end_time > (select time from game where id = ?)) or (time > (select time from game where id = ?) and time < (select end_time from game where id = ?)))) and RCid = ?");
1291
#  my $sth = $dbh->prepare("select count(*) from v_shift_all where id in (select id from v_shift_all where date = (select date from v_shift_all where id = ?) and ((start_time <= (select start_time from v_shift_all where id = ?) and end_time > (select start_time from v_shift_all where id = ?)) or (start_time > (select start_time from v_shift_all where id = ?) and start_time < (select end_time from v_shift_all where id = ?)))) and RCid = ?");
1292
 
1293
  ($conflicts) = $dbh->selectrow_array ("select * from (
1294
    select concat(dept, '-', id) as conflict from v_shift          where date = ? and ((start_time <= ? and end_time > ?) or (start_time > ? and start_time < ?)) and RCid = ? union
1295
    select concat('CLA:', id) as conflict from v_class_signup_new  where date = ? and ((start_time <= ? and end_time > ?) or (start_time > ? and start_time < ?)) and RCid = ? union
1296
    select concat('ANN-', id) as conflict from v_shift_announcer   where date = ? and ((start_time <= ? and end_time > ?) or (start_time > ? and start_time < ?)) and RCid = ? union
1297
    select concat('OFF-', id) as conflict from v_shift_officiating where date = ? and ((start_time <= ? and end_time > ?) or (start_time > ? and start_time < ?)) and RCid = ? ) alltables
1298
    where conflict <> ?",
1299
    undef, $date, $start, $start, $start, $end, $rcid, $date, $start, $start, $start, $end, $rcid, $date, $start, $start, $start, $end, $rcid, $date, $start, $start, $start, $end, $rcid, "PER-".$existing
1300
  );
1301
 
1302
  return $conflicts;
1303
}
1304
 
1305
sub changeLeadShift {
1306
  my ($change, $lshift, $user_id) = @_;
1307
  my $ERRMSG;
1308
 
1309
  my $sth = $dbh->prepare("update lead_shift set assignee_id = ? where id = ?");
1310
 
1311
  print "<br>attempting to make DB changes...<br>";
1312
  if ($change eq "add") {
1313
    $sth->execute($user_id, $lshift)
1314
      or $ERRMSG = "ERROR: Can't execute SQL statement: ".$sth->errstr()."\n";
1315
  } elsif ($change eq "del") {
1316
    $sth->execute('', $lshift)
1317
      or $ERRMSG = "ERROR: Can't execute SQL statement: ".$sth->errstr()."\n";
1318
  }
1319
  if ($ERRMSG) {
1320
    print $ERRMSG;
1321
  } else {
1322
    logit($user_id, "Lead Shift ".ucfirst($change).": $lshift");
1323
    print "Success.<br>";
1324
  }
1325
}
1326
 
1327
sub logit {
1328
  my $RCid = shift;
1329
  my $msg = shift;
1330
  my $sth = $dbh->prepare("insert into log (person_id, ip_address, event) values (?, ?, ?)");
1331
  $sth->execute($RCid, $ENV{REMOTE_ADDR}, $msg);
1332
}
1333
 
1334
sub orglogit {
1335
  my $RCid = shift;
1336
  my $org = shift;
1337
  my $msg = shift;
1338
  $dbh->do ("insert into organization_log (person_id, organization_id, ip_address, event) values (?, ?, ?, ?)", undef, $RCid, $org, $ENV{REMOTE_ADDR}, $msg);
1339
}
1340
 
1341
sub sendUserMFAEMail {
1342
  my $user = shift // return "ERROR [sendUserMFAEMail]: No user data sent to function.";
1343
  use PEEPSMailer;
1344
  use HTML::Tiny;
1345
  my $h = HTML::Tiny->new( mode => 'html' );
11 - 1346
  $ENV{HTTPS} = 'ON' if $ENV{SERVER_NAME} =~ /^peeps/;
2 - 1347
 
1348
  return "ERROR [sendUserMFAEMail]: No email address found for user" unless $user->{email};
1349
 
1350
  my $random_six_digit_number = 100000 + int(rand(900000));
1351
  my $string_number = sprintf ("%06d", $random_six_digit_number);
1352
  $dbh->do ("update authentication set mfa = ?, mfa_timestamp = now() where person_id = ?", undef, $string_number, $user->{person_id});
1353
 
11 - 1354
  my $subject = 'WFTDI PEEPS - Login MFA Verification Code';
1355
  my $body = $h->p ({ style => "font-family: Verdana;" }, "Greetings,", "It appears you are trying to log into PEEPS from somewhere new. Here's a code to enter:");
1356
  $body .= $h->p ({ style => "font-family: Verdana; font-size: larger; font-weight: bold;" }, $string_number);
1357
  $body .= $h->p ({ style => "font-family: Verdana;" }, "Or click ".$h->a ({ href => url ()."?authenticate=".$string_number }, "this link").".");
1358
  $body .= $h->p ({ style => "font-family: Verdana; font-size: smaller; font-style: italic;" }, "", "Sent by PEEPS Automated Emailer");
2 - 1359
 
1360
  EmailUser ($user->{email}, $subject, $body);
1361
}
1362
 
1363
sub sendNewUserEMail {
1364
  my $context = shift;
1365
  my $data = shift;
1366
  use PEEPSMailer;
1367
  use HTML::Tiny;
1368
  my $h = HTML::Tiny->new( mode => 'html' );
1369
  my $depts = getDepartments (); # HashRef of the department TLAs -> Display Names...
1370
  my $AccessLevel = getAccessLevels;
1371
 
1372
  my $email = $data->{email};
1373
  my $subject = 'WFTDI PEEPS - New User';
1374
  my $body;
1375
  if ($context eq "New User") {
1376
    $subject .= " Request";
4 - 1377
    $ENV{HTTPS} = 'ON' if $ENV{SERVER_NAME} =~ /^peeps/;
2 - 1378
    my $activationlink = url ()."?activate=".$data->{activation};
1379
    $body = $h->p ("Greetings,");
1380
    $body .= $h->p ("It appears as though you've registered a new account in WFTDI's PEEPS system with the following information:");
1381
    $body .= $h->table ([
1382
      $h->tr ([$h->td ("&nbsp;&nbsp;", "Derby Name:",    $data->{derby_name})]),
1383
      $h->tr ([$h->td ("&nbsp;&nbsp;", "Civil Name:",    join (" ", $data->{name_first}, $data->{name_middle}, $data->{name_last}))]),
1384
      $h->tr ([$h->td ("&nbsp;&nbsp;", "Email Address:", $data->{email})]),
1385
    ]);
1386
    $body .= $h->p ("To validate that you've entered a real (and correct) email address (and that you're not a spam-bot), please click the following link:",
1387
      $h->a ({ HREF=>$activationlink }, "Activate my PEEPS Account!"), $h->br,
1388
      "Or you can copy/paste this into the 'Activation Code' box: ".$data->{activation}, $h->br,
1389
      "Once activated, you'll be able to log in.",
1390
      "If you didn't make this request, well, you're still the only one who received this email, and you now have an account request.  You should probably let us know that someone is messing with you.",
1391
      $h->br,
1392
      "--PEEPS Automated Emailer");
41 - 1393
  } elsif ($context eq "Email Change") {
1394
    $subject = 'WFTDI PEEPS - Email Change';
1395
    $ENV{HTTPS} = 'ON' if $ENV{SERVER_NAME} =~ /^peeps/;
1396
    my $activationlink = url ()."?activate=".$data->{activation};
1397
    $body = $h->p ("Greetings,");
1398
    $body .= $h->p ("It appears as though you've changed your email address in WFTDI's PEEPS system:");
1399
    $body .= $h->table ([
1400
      $h->tr ([$h->td ("&nbsp;&nbsp;", "Derby Name:",    $data->{derby_name})]),
1401
      $h->tr ([$h->td ("&nbsp;&nbsp;", "Civil Name:",    join (" ", $data->{name_first}, $data->{name_middle}, $data->{name_last}))]),
1402
      $h->tr ([$h->td ("&nbsp;&nbsp;", "New Email Address:", $data->{email})]),
1403
    ]);
1404
    $body .= $h->p ("To validate that you've entered a real (and correct) email address (and that you're not a spam-bot), please click the following link:",
1405
      $h->a ({ HREF=>$activationlink }, "Re-activate my PEEPS Account!"), $h->br,
1406
      "Or you can copy/paste this into the 'Activation Code' box: ".$data->{activation}, $h->br,
1407
      "Once re-activated, you'll be able to log in again.",
1408
      "If you didn't make this request, well, you're still the only one who received this email, and your username hasn't changed.  You should probably let us know that someone is messing with you.",
1409
      $h->br,
1410
      "--PEEPS Automated Emailer");
2 - 1411
  } elsif ($context eq "Activate") {
1412
    $subject .= " Activated!";
1413
    $body = "Greetings again,
1414
 
1415
Your PEEPS account has been actived.
1416
 
1417
--PEEPS Automated Emailer
1418
";
1419
  } else {
1420
    return;
1421
  }
1422
  # send the message
1423
  EmailUser ($email, $subject, $body);
1424
 
1425
}
1426
 
1427
sub isPersonCovered {
1428
  my $pid = shift // "";
1429
  my $date = shift // "";
1430
 
1431
  return "" unless $pid =~ /^\d+$/;
1432
  return "" unless !$date or $date =~ /^\d{4}-\d{2}-\d{2}$/;
1433
 
1434
  my $policy_id;
1435
  if ($date) {
22 - 1436
    ($policy_id) = $dbh->selectrow_array ("select id from coverage where person_id = ? and datediff(start, ?) <= 1 and datediff(end, ?) >= 0 and isnull(coverage.terminated) = 1 and policy_id = 1", undef, $pid, $date, $date);
2 - 1437
  } else {
22 - 1438
    ($policy_id) = $dbh->selectrow_array ("select id from coverage where person_id = ? and datediff(start, now()) < 1 and datediff(end, now()) >= 0 and isnull(coverage.terminated) = 1 and policy_id = 1", undef, $pid);
2 - 1439
  }
1440
 
1441
  return $policy_id;
1442
}
1443
 
1444
sub isLeagueCovered {
1445
  my $pid = shift // "";
1446
  my $date = shift // "";
1447
  my $type = shift // "WFTDA General Liability Insurance";
1448
 
1449
  return "" unless $pid =~ /^\d+$/;
1450
  return "" unless !$date or $date =~ /^\d{4}-\d{2}-\d{2}$/;
1451
 
1452
  my $policy_id;
1453
  if ($date) {
1454
    ($policy_id) = $dbh->selectrow_array ("select id from org_coverage where policy_name = ? and organization_id = ? and datediff(start, ?) <= 1 and datediff(end, ?) >= 0 and isnull(org_coverage.terminated) = 1", undef, $type, $pid, $date, $date);
1455
  } else {
1456
    ($policy_id) = $dbh->selectrow_array ("select id from org_coverage where policy_name = ? and organization_id = ? and datediff(start, now()) < 1 and datediff(end, now()) >= 0 and isnull(org_coverage.terminated) = 1", undef, $type, $pid);
1457
  }
1458
 
1459
  return $policy_id;
1460
}
1461
 
1462
sub isLeagueAdmin {
1463
  my $person = shift // "";
1464
 
1465
  if (ref $person eq "HASH") {
1466
    $person = $person->{person_id};
1467
  }
1468
 
1469
  die "ERROR: function isLeagueAdmin(person_id) didn't receive proper argument" unless $person =~ /^\d+$/;
1470
 
1471
  my @array_of_leagues = map { $_->[0] } @{ $dbh->selectall_arrayref ("select member_org_id from role where person_id = ? and role = ?", undef, $person, "League Admin") };
1472
 
1473
  return scalar @array_of_leagues ? \@array_of_leagues : [];
1474
}
1475
 
1476
sub isWFTDAMember {
1477
  my $pid = shift // "";
1478
  return "" unless $pid =~ /^\d+$/;
1479
 
1480
  my ($membership) = $dbh->selectrow_array ("select count(*) from organization where type = ? and status = ? and id in (select member_org_id from role where person_id = ?)", undef, "member league", "Active", $pid);
1481
 
1482
  return $membership;
1483
}
1484
 
1485
sub remainingPolicyDays {
1486
  my $person = shift // "";
1487
  my $policy = shift // "";
1488
 
1489
  return "" unless $person =~ /^\d+$/;
1490
  return "" unless $policy =~ /^\d+$/;
1491
 
1492
  my ($days_remaining) = $dbh->selectrow_array ("select datediff(end, now()) from coverage where id = ? and person_id = ?", undef, $policy, $person);
1493
 
1494
  return defined $days_remaining ? $days_remaining : "ERROR: Policy Not Found";
1495
}
1496
 
1497
sub remainingOrgPolicyDays {
1498
  my $league = shift // "";
1499
  my $policy = shift // "";
1500
 
1501
  return "" unless $league =~ /^\d+$/;
1502
  return "" unless $policy =~ /^\d+$/;
1503
 
1504
  my ($days_remaining) = $dbh->selectrow_array ("select datediff(end, now()) from org_coverage where id = ? and organization_id = ?", undef, $policy, $league);
1505
 
1506
  return defined $days_remaining ? $days_remaining : "ERROR: Policy Not Found";
1507
}
1508
 
1509
1;