Pm/Date.pm
Copying Source is Forbidden
1120 lines of code
1
package Date;
2
3
#/
4
# a module for retrieving dates
5
#/
6
7
#CHLOG
8
# CHANGE LOG
9
# ==========
10
# - May 5, 2021
11
# - Added Change Log
12
#CHLOG
13
14
use strict;
15
use warnings;
16
use CGI::Carp qw(fatalsToBrowser);
17
use Exporter;
18
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT);
19
20
$VERSION = 1.00;
21
@ISA = qw(Exporter);
22
@EXPORT = qw(
23
get_today
24
isa_date
25
);
26
@EXPORT_OK = qw(
27
_tests
28
29
get_date
30
get_day
31
get_DoW
32
get_DoW_abbr
33
get_february_days
34
get_month
35
get_month_abbr
36
get_month_days
37
get_time
38
get_today
39
get_today_cookie_style
40
get_year
41
42
add_date
43
determine_zodiac
44
expand_date
45
minus_date
46
short_date
47
48
isa_date
49
isAfterToday
50
isBeforeToday
51
isAfterDate
52
isBeforeDate
53
isNew
54
55
valid_date
56
);
57
58
##############################
59
60
use lib "./Pm";
61
62
require Bc_misc;
63
#use Bc_misc qw(add_numeric_suffix Bc_misc::add_zeros);
64
require Bc_sql;
65
#use Bc_sql qw(
66
# Bc_sql::get_constant
67
# sql_execute
68
# user_exists
69
# $LOGGEDIN
70
71
# $DB
72
# );
73
74
75
##############################
76
77
78
79
##############################
80
sub get_month($) {
81
#*
82
# gets the full name of a given date or month number
83
# (eg: 1976-01-19 or 1 or 01 will return January)
84
#*
85
my ($given) = @_; # a date, or month number
86
my $rv = "";
87
88
my ($y, $m, $d) = split("-", $given);
89
if (not $m) { $m = $given; }
90
91
#first, remove any leading zeros!
92
$m =~ s/^(0)*//;
93
94
if (not $m) { $m = 1; }
95
elsif ($m < 1) { $m = 1; }
96
elsif ($m > 12) { $m = 12; }
97
98
if ($m eq 1) { $rv = "January"; }
99
elsif ($m eq 2) { $rv = "February"; }
100
elsif ($m eq 3) { $rv = "March"; }
101
elsif ($m eq 4) { $rv = "April"; }
102
elsif ($m eq 5) { $rv = "May"; }
103
elsif ($m eq 6) { $rv = "June"; }
104
elsif ($m eq 7) { $rv = "July"; }
105
elsif ($m eq 8) { $rv = "August"; }
106
elsif ($m eq 9) { $rv = "September"; }
107
elsif ($m eq 10) { $rv = "October"; }
108
elsif ($m eq 11) { $rv = "November"; }
109
elsif ($m eq 12) { $rv = "December"; }
110
111
return $rv; # a scalar
112
#usage: my $month_name = get_month(4); # "April"
113
}
114
115
##############################
116
sub get_month_abbr($) {
117
#*
118
# gets the month in abbreviated format
119
# (just calls get_month() and strips all but the first
120
# three characters)
121
#*
122
my ($mnum) = @_; # a month number (8)
123
my $mon = get_month($mnum); # september
124
my $toStrip = $mon; # september
125
$toStrip =~ s/^[a-z][a-z][a-z]//i; # tember
126
$mon =~ s/$toStrip//i; # sep
127
return $mon; # a scalar
128
#usage: my $month_abbr = get_month_abbr(1); # Jan
129
}
130
131
##############################
132
sub get_day(;$) {
133
#*
134
# adds st, nd, rd, or th to a number (from 1 to 31 anyway)
135
# 0 gets no suffix
136
# unless you give it no $d! lol then, it will give you today's day
137
# 11th, 12th, 13th. if you would like to not have the suffix, pass in -1
138
# leading zeros are not inserted in results
139
# leading zeros will be removed from input
140
#*
141
my ($d) = @_; # a day of the month (optional, eg: 13, no default)
142
my $grab_today = 0;
143
# okay, did you give me a number from 1 to 31?
144
if ($d) {
145
if ($d >= 1 and $d <= 31) {
146
if ($d !~ /st|nd|rd|th$/) {
147
if ($d < 1) { $d = 1; }
148
elsif ($d > 31) { $d = 31; }
149
$d = Bc_misc::add_numeric_suffix($d);
150
}
151
} elsif ($d == -1) {
152
$d = get_today("d");
153
}
154
} else {
155
$d = Bc_misc::add_numeric_suffix(get_today("d"));
156
}
157
158
$d =~ s/^(0)*//;
159
160
return $d; # a scalar
161
#usage: my $d = get_day(21); # "21st"
162
}
163
164
##############################
165
sub isa_date($) {
166
#*
167
# deteremines if $d looks like a date
168
# a qualifying date is: 1976-01-19
169
# any other format will fail! for now
170
#*
171
my ($d) = @_; # a date (eg: 1976-01-19)
172
my $rv = 0;
173
174
# first, see if we get three bits.
175
my @bits = split("-", $d); # [0] = year, [1] = month, [2] = day
176
if (@bits == 3) {
177
# okay. three bits.
178
# do we have four digits for the year, and two for month and day?
179
if ($bits[0] =~ /[0-9][0-9][0-9][0-9]/ and
180
$bits[1] =~ /[0-9][0-9]/ and
181
$bits[2] =~ /[0-9][0-9]/
182
) {
183
$rv = 1;
184
}
185
}
186
187
return $rv; # 1 if $d is a date, or 0 if not
188
#usage: if (isa_date("bob's yer fuckin uncle")) { ... }
189
}
190
191
##############################
192
sub get_DoW($) {
193
#*
194
# retrieves the day of week (eg 0 = sunday)
195
# if <b>$d</b> is less than 1, it's set to 1
196
# if <b>$d</b> is greater than 7, it's set to 7
197
# or the name of the day of a given date in the
198
# format of 1976-01-19
199
#*
200
my ($d) = @_; # a number representing a day of the week (eg 2 for tuesday) or a date.
201
my $dow = 1;
202
203
if (isa_date($d)) {
204
my $days_remaining = 0;
205
my $num_leapyears = 0;
206
my $num_days = 0;
207
my $leap_start = 0;
208
my $leap_end = 0;
209
my $daycount = 0;
210
my $numweeks = 0;
211
# calculate the dow.
212
# for now, $d will be set to 9
213
# ah but how. we have almost all the info:
214
# - the date itself
215
# - a function to tell us if a year is a leapyear
216
# - just missing the actual calculation lol
217
my $today = get_today("db", 1);
218
my @date = split("-", $d);
219
my @todate = split("-", $today);
220
221
if (isBeforeDate($d, $today)) {
222
$leap_start = $date[0];
223
$leap_end = $todate[0];
224
} else {
225
$leap_start = $todate[0];
226
$leap_end = $date[0];
227
}
228
229
for (my $i = $leap_start; $i <= $leap_end; $i++) {
230
if (get_february_days($i) == 29) { $num_leapyears++; }
231
}
232
233
# every 7 days from today (say a tuesday) and here after, it will be tuesday again
234
# so how many days have we got to work with?
235
# each n every year has at least 365 days
236
# we've got the number of leap years (which equates to a number of extra days), if applicable
237
# so, let's count the days between $leap_start and $leap_end. but how?
238
my $count_date = "";
239
my $count_end = "";
240
if (isBeforeDate($d, $today))
241
{ $count_date = $d; $count_end = $today; } else
242
{ $count_date = $today; $count_end = $d; }
243
244
while ($count_date ne $count_end) {
245
$count_date = add_date($count_date, 1, "d");
246
$daycount++;
247
}
248
249
# k, that should give us our day count.
250
# let's see?
251
252
if ($daycount > 7) {
253
$numweeks = int $daycount / 7;
254
$days_remaining = $daycount % 7;
255
}
256
257
# k, that should get us what we need now.
258
# now get dow of today! (eg 2 for tuesday)
259
# then, add $days_remaining to that result
260
# if the addition results in 7 or higher,
261
# minus 7 from it. this should give us
262
# the dow of the date given. all
263
# without having to worry about leap years,
264
# because add_date should have worried for us.
265
266
if (isBeforeDate($d, $today)) {
267
$d = get_today("dow") - $days_remaining;
268
if ($d < 0) { $d += 7; }
269
} else {
270
$d = get_today("dow") + $days_remaining;
271
if ($d > 6) { $d -= 7; }
272
}
273
}
274
275
if ($d < 0) { $d = 0; }
276
if ($d > 6) { $d = 6; }
277
278
if ($d eq 0) { $dow = "Sunday"; }
279
if ($d eq 1) { $dow = "Monday"; }
280
if ($d eq 2) { $dow = "Tuesday"; }
281
if ($d eq 3) { $dow = "Wednesday"; }
282
if ($d eq 4) { $dow = "Thursday"; }
283
if ($d eq 5) { $dow = "Friday"; }
284
if ($d eq 6) { $dow = "Saturday"; }
285
286
return $dow; # a scalar
287
#usage: my $dow = get_DoW(34); # returns "Saturday";
288
}
289
290
##############################
291
sub get_DoW_abbr($) {
292
#*
293
# retrieves an abbreviated version of the day of week (eg 0 = sun)
294
# if <b>$d</b> is less than 1, it's set to 1
295
# if <b>$d</b> is greater than 7, it's set to 7
296
#*
297
my ($d) = @_; # a number representing a day of the week (eg 2 for Mon)
298
my $udow = get_DoW($d);
299
my $toStrip = $udow;
300
$toStrip =~ s/^[a-z][a-z][a-z]//i;
301
$udow =~ s/$toStrip//i;
302
return $udow; # a scalar
303
#usage: my $dow_abbr = get_DoW_abbr(6); # "Sat"
304
}
305
306
##############################
307
sub get_time(;$$) {
308
#*
309
# retrieves the time as "HH:MM:SS [GMT]/[ST]"
310
#*
311
my ($part, $zerosAdded) = @_; # to get just one component of the time. can be: s,m,h,gmt && to insert leading zeros into the time (optional)
312
my ($secs, $mins, $hrs, $isDist);
313
if ($part eq 'gmt') {
314
($secs, $mins, $hrs) = (gmtime)[0..2];
315
} else {
316
($secs, $mins, $hrs) = (localtime)[0..2];
317
$isDist = (localtime)[8];
318
}
319
my $rv = "";
320
321
$secs =~ s/^(0)*//;
322
$mins =~ s/^(0)*//;
323
$hrs =~ s/^(0)*//;
324
if ($zerosAdded or $part eq 'gmt') {
325
$secs = Bc_misc::add_zeros($secs);
326
$mins = Bc_misc::add_zeros($mins);
327
$hrs = Bc_misc::add_zeros($hrs);
328
}
329
330
{ ########################
331
if ($part eq 's') { $rv = $secs; }
332
elsif ($part eq 'm') { $rv = $mins; }
333
elsif ($part eq 'h') { $rv = $hrs; }
334
elsif ($part eq 'gmt') { $rv = "$hrs:$mins:$secs (GMT)"; }
335
else {
336
$rv = "$hrs:$mins:$secs (ST)";
337
}
338
} ########################
339
340
return $rv; # a scalar
341
#usage: my $time = get_time("gmt", 1); # time in GMT format with one leading zero, when required or requested
342
}
343
344
##############################
345
sub get_today(;$$) {
346
#*
347
# retrieves today's date.<br>
348
349
# assign to $part any ONE of the following:
350
# <b>c</b> = cookie style dates
351
# <b>d</b> = retrieves only the day of the month
352
# <b>day</b> = just like "d", but adds "st", "nd", "rd" or "th"
353
# <b>dow</b> = retrieves the # of the day of the week (like Monday)
354
# <b>m</b> = retrieves the month number
355
# <b>month</b> = retrieves the unabbreviated month name (like January)
356
# <b>y</b> = returns just the year (4 digits)
357
# <b>st</b> = returns the time in standard time
358
# <b>gmt</b> = returns the time in GMT
359
# <b>sd</b> = returns the date in server date (default)
360
# <b>gd</b> = returns the date in greenwich mean
361
# <b>db</b> = a date fit for export to db table records
362
# <b>t</b> = time now<br>
363
364
# no params to get a full date, with GMT time<br>
365
366
# if $part eq "dow" and $zerosAdded == 1, returns name of dow (ie: Sunday)
367
# else, returns number of the day of week (ie: 0)
368
#*
369
my ($part, $zerosAdded) = @_; # to get just one component of today's date, or format selection && to insert leading zeros into the date, where appropriate (optional)
370
$part = lc($part);
371
my ($day, $month, $year, $dow, $rv) = ("", "", "", "", "");
372
373
if ($part eq 'gmt')
374
{ ($day, $month, $year, $dow) = (gmtime)[3..6]; } else
375
{ ($day, $month, $year, $dow) = (localtime)[3..6]; }
376
377
$month += 1;
378
$year += 1900;
379
if ($part) {
380
if ($part eq 'c') { $rv = get_today_cookie_style(); }
381
elsif ($part eq 'd') { $rv = $day; }
382
elsif ($part eq 'day') { $rv = get_day($day); }
383
elsif ($part eq 'dow') {
384
if ($zerosAdded) { $dow = get_DoW($dow); }
385
$rv = $dow;
386
}
387
elsif ($part eq 'm') { $rv = $month; }
388
elsif ($part eq 'month') { $rv = get_month($month); }
389
elsif ($part eq 'y') { $rv = $year; }
390
elsif ($part eq 'st') { $rv = get_time('', 0); }
391
elsif ($part eq 'gmt') { $rv = get_time('gmt', 0); }
392
elsif ($part eq 'sd') { $rv = get_date(''); }
393
elsif ($part eq 'gd') { $rv = get_date('gmt'); }
394
elsif ($part eq 'db') { $rv = get_date('db'); }
395
elsif ($part eq 't') { $rv = get_time('gmt', 0); }
396
elsif ($part eq 't24') {
397
my $h = get_time('h', 0);
398
}
399
} else {
400
$rv = get_DoW($dow) . ", " . get_month($month) . " " . get_day($day) . ", $year - " . get_time('gmt', 0);
401
}
402
403
if ($zerosAdded and $part =~ /^[d|m|y]$/) {
404
if ($rv < 10) {
405
$rv = "0" . $rv;
406
}
407
}
408
# seems we're getting a leading space...so, let's just remove it for now
409
$rv =~ s/^( )*//;
410
return $rv; # a scalar
411
#usage: get_today(""); # server date formatted as <b>Monday, January 19th, 1976 - 18:18:16 (GMT)</b>
412
}
413
414
##############################
415
sub get_date(;$) {
416
#*
417
# retrieves the date.<br>
418
419
# assign to $part any ONE of the following:
420
# <b>""</b> = returns server date, formatted "Monday, January 19th, 1976"
421
# <b>gmt</b> = returns the time in GMT
422
# <b>db</b> = a date fit for import into DB table records
423
# <b>cookie</b> = a date fit for setting cookie expiration dates<br>
424
425
# when $part = "db" will always return the local date (with leading zeros,
426
# as needed), and will be formatted 1976-01-19
427
#*
428
my ($part) = @_; # for greenwich mean time (gmt) or server time (st), or DB format (optional)
429
$part = lc($part);
430
my $zerosAdded = $_[1];
431
my ($day, $dow, $month, $year, $rv, $divider);
432
433
if ($part eq 'gmt') {
434
($day, $month, $year, $dow) = (gmtime)[3..6];
435
$month += 1;
436
$year += 1900;
437
$dow = get_DoW($dow);
438
$day = get_day($day);
439
$month = get_month($month);
440
$rv = "$dow, $month $day, $year";
441
} elsif ($part eq "cookie") {
442
$rv = get_today_cookie_style();
443
} elsif ($part eq "db") {
444
($day, $month, $year) = (localtime)[3..5];
445
$month += 1;
446
$year += 1900;
447
if ($month < 10) { $month = "0" . $month; }
448
if ($day < 10) { $day = "0" . $day; }
449
$rv = " $year-$month-$day";
450
} else {
451
($day, $month, $year, $dow) = (localtime)[3..6];
452
$month += 1;
453
$year += 1900;
454
$dow = get_DoW($dow);
455
$day = get_day($day);
456
$month = get_month($month);
457
$rv = "$dow, $month $day, $year";
458
}
459
460
if ($part eq 'gmt') { $rv.= " (GMT)"} elsif ($part ne "db" and $part ne "cookie") { $rv .= " (ST)"; }
461
$rv =~ s/^ *//g;
462
463
return $rv; # a scalar
464
#usage: my $gmt = get_date("gmt"); # the date in gmt
465
}
466
467
##############################
468
sub get_today_cookie_style() {
469
#*
470
# retrieves the date suitable for use in making cookies, gmt
471
#*
472
#@_; # (no parameters)
473
my @today = gmtime;
474
my $DST = 1;
475
my $now = get_DoW_abbr($today[6]) . ", " . $today[3] . "-" . get_month_abbr($today[4]+1) . "-" . ($today[5]+1900) . " " . Bc_misc::add_zeros(($today[2])) . ":" . Bc_misc::add_zeros($today[1]+$DST) . ":" . Bc_misc::add_zeros($today[0]) . " GMT";
476
477
return $now; # a scalar
478
#usage: my $cDate = get_today_cookie_style();
479
}
480
481
##############################
482
sub get_year() {
483
#*
484
# retrieves the current year, local time
485
#*
486
#@_; # (no parameters)
487
my $year = (localtime)[5];
488
$year += 1900;
489
490
return $year; # a number
491
#usage: my $thisyear = get_year();
492
}
493
494
##############################
495
sub expand_date($;$) {
496
#*
497
# converts the provided date into words.
498
# eg: 1976-01-19 => January 19th, 1976
499
#*
500
my ($d, $abbreviated) = @_; # a date (use get_date(), for example) && abbreviated form of the expanded date (optional, eg: Oct 28/18)
501
my @date = split("-", $d);
502
#my $day = get_day($date[0]);
503
#my $month = get_month($date[1]);
504
#my $year = $date[2];
505
my $day = get_day($date[2]);
506
my $month = "";
507
if ($abbreviated)
508
{ $month = get_month_abbr($date[1]); } else
509
{ $month = get_month($date[1]); }
510
my $year = $date[0];
511
my $expandedDate = $month . " " . $day . ", " . $year;
512
513
return $expandedDate; # a scalar
514
#usage: my $date = expand_date(get_today(""));
515
}
516
517
########################
518
sub valid_date($) {
519
#*
520
# determines if a given date is valid or not
521
#*
522
my ($d) = @_; # a date (eg: 1976-01-19)
523
my $rv = 1;
524
525
# first, let's split the date into it's three components;
526
my @dbits = split("-", $d);
527
528
# @ipbits should contain exactly three elements
529
if (@dbits ne 3) {
530
$rv = 0;
531
} else {
532
my $mdays = Date::get_month_days($d);
533
# now make sure the bits are valid year, month, and day values
534
if ($dbits[0] < 1 or $dbits[0] > 9999) { $rv = 0; }
535
if ($dbits[1] < 1 or $dbits[1] > 12) { $rv = 0; }
536
if ($dbits[2] < 1 or $dbits[2] > $mdays) { $rv = 0; }
537
}
538
539
return $rv; # 1 if valid, or 0 if not
540
#usage: if (valid_date($)) { print "date is acceptable"; }
541
}
542
543
##############################
544
sub short_date($) {
545
#*
546
# converts the provided date into a short, numeric form.
547
# eg: Monday, January 19th, 1976 => 1976-01-19
548
#*
549
my ($d) = @_; # a date (Monday, January 19th, 1976 for example)
550
my $rv = 0;
551
552
# now we should have "January 19th, 1976"
553
my ($DoW, $M, $D, $Y) = split(" ", $d);
554
$D =~ s/[a-z][a-z],$//;
555
if ($D < 10) { $D = "0$D"; }
556
557
$rv = $D;
558
if ($M =~ /^january$/i) { $M = 1; }
559
elsif ($M =~ /^february$/i) { $M = 2; }
560
elsif ($M =~ /^march$/i) { $M = 3; }
561
elsif ($M =~ /^april$/i) { $M = 4; }
562
elsif ($M =~ /^may$/i) { $M = 5; }
563
elsif ($M =~ /^june$/i) { $M = 6; }
564
elsif ($M =~ /^july$/i) { $M = 7; }
565
elsif ($M =~ /^august$/i) { $M = 8; }
566
elsif ($M =~ /^september$/i) { $M = 9; }
567
elsif ($M =~ /^october$/i) { $M = 10; }
568
elsif ($M =~ /^november$/i) { $M = 11; }
569
elsif ($M =~ /^december$/i) { $M = 12; }
570
if ($M < 10) { $M = "0$M"; }
571
$rv .= "-$M";
572
573
$rv .= "-$Y";
574
575
return $rv; # a scalar
576
#usage: my $date = short_date("Monday, January 19th, 1976");
577
}
578
579
##############################
580
sub determine_zodiac($$) {
581
#*
582
# returns a zodiac associated with a given date (tropical zodiac)
583
# valid values for <b>$style</b>:
584
# "" = as word
585
# i = as image
586
# n = as number
587
#*
588
my ($d, $style) = @_; # a date in the format of <i>yyyy-mm-dd</i> (fe: 1976-01-19) && a style of output (optional)
589
590
my ($year, $month, $day) = split("-", $d);
591
if (not $month) { $month = 1; }
592
if (not $day) { $day = 1; }
593
my $zodiac = "Capricorn";
594
595
if ($month eq "01" or $month eq "1" or $month eq 1) { if ($day < 21) { $zodiac = "Capricorn"; } else { $zodiac = "Aquarius"; } } # January
596
if ($month eq "02" or $month eq "2" or $month eq 2) { if ($day < 20) { $zodiac = "Aquarius"; } else { $zodiac = "Pisces"; } } # February
597
if ($month eq "03" or $month eq "3" or $month eq 3) { if ($day < 21) { $zodiac = "Pisces"; } else { $zodiac = "Aries"; } } # March
598
if ($month eq "04" or $month eq "4" or $month eq 4) { if ($day < 21) { $zodiac = "Aries"; } else { $zodiac = "Taurus"; } } # April
599
if ($month eq "05" or $month eq "5" or $month eq 5) { if ($day < 22) { $zodiac = "Taurus"; } else { $zodiac = "Gemini"; } } # May
600
if ($month eq "06" or $month eq "6" or $month eq 6) { if ($day < 22) { $zodiac = "Gemini"; } else { $zodiac = "Cancer"; } } # June
601
if ($month eq "07" or $month eq "7" or $month eq 7) { if ($day < 23) { $zodiac = "Cancer"; } else { $zodiac = "Leo"; } } # July
602
if ($month eq "08" or $month eq "8" or $month eq 8) { if ($day < 23) { $zodiac = "Leo"; } else { $zodiac = "Virgo"; } } # August
603
if ($month eq "09" or $month eq "9" or $month eq 9) { if ($day < 24) { $zodiac = "Virgo"; } else { $zodiac = "Libra"; } } # September
604
if ($month eq "10" or $month eq "10" or $month eq 10) { if ($day < 24) { $zodiac = "Libra"; } else { $zodiac = "Scorpio"; } } # October
605
if ($month eq "11" or $month eq "11" or $month eq 11) { if ($day < 23) { $zodiac = "Scorpio"; } else { $zodiac = "Sagittarius"; } } # November
606
if ($month eq "12" or $month eq "12" or $month eq 12) { if ($day < 22) { $zodiac = "Sagittarius"; } else { $zodiac = "Capricorn"; } } # December
607
608
if ($style eq "i") {
609
if ($zodiac eq "Capricorn") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/capricorn2.png&s=ss\" title='Capricorn'>"; }
610
elsif ($zodiac eq "Aquarius") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/aquarius2.png&s=ss\" title='Aquarius'>"; }
611
elsif ($zodiac eq "Pisces") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/pisces2.png&s=ss\" title='Pisces'>"; }
612
elsif ($zodiac eq "Aries") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/aries2.png&s=ss\" title='Aries'>"; }
613
elsif ($zodiac eq "Taurus") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/taurus2.png&s=ss\" title='Taurus'>"; }
614
elsif ($zodiac eq "Gemini") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/gemini2.png&s=ss\" title='Gemini'>"; }
615
elsif ($zodiac eq "Cancer") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/cancer2.png&s=ss\" title='Cancer'>"; }
616
elsif ($zodiac eq "Leo") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/leo2.png&s=ss\" title='Leo'>"; }
617
elsif ($zodiac eq "Virgo") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/virgo2.png&s=ss\" title='Virgo'>"; }
618
elsif ($zodiac eq "Libra") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/libra2.png&s=ss\" title='Libra'>"; }
619
elsif ($zodiac eq "Scorpio") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/scorpio2.png&s=ss\" title='Scorpio'>"; }
620
elsif ($zodiac eq "Sagittarius") { $zodiac = "<img src=\"" . Bc_sql::get_constant("IMAGE_SERVER") . "/img.pl?i=zodiacs/sagittarius2.png&s=ss\" title='Sagittarius'>"; }
621
622
} elsif ($style eq "n") {
623
624
if ($zodiac eq "Aquarius") { $zodiac = 1; }
625
elsif ($zodiac eq "Gemini") { $zodiac = 2; }
626
elsif ($zodiac eq "Capricorn") { $zodiac = 3; }
627
elsif ($zodiac eq "Taurus") { $zodiac = 4; }
628
elsif ($zodiac eq "Sagittarius") { $zodiac = 5; }
629
elsif ($zodiac eq "Scorpio") { $zodiac = 6; }
630
elsif ($zodiac eq "Leo") { $zodiac = 7; }
631
elsif ($zodiac eq "Cancer") { $zodiac = 8; }
632
elsif ($zodiac eq "Libra") { $zodiac = 9; }
633
elsif ($zodiac eq "Pisces") { $zodiac = 10; }
634
elsif ($zodiac eq "Virgo") { $zodiac = 11; }
635
elsif ($zodiac eq "Aries") { $zodiac = 12; }
636
}
637
638
return $zodiac; # a scalar
639
#usage: my $z = determine_zodiac("19/01/1976", "i");
640
}
641
642
##############################
643
sub get_february_days($) {
644
#*
645
# gets the number of days in february for a given $date
646
# $date cannot have a year less than 1, or greater than 9999
647
# since split returns the string when there's nothing to split
648
# $date can be just a year (eg: 1976)
649
#*
650
my ($date) = @_; # a date (eg: 1976-01-19 or 1976)
651
my ($y, $m, $d) = split("-", $date);
652
653
# strip all leading zeros
654
$y =~ s/^(0)*//;
655
if ($m) { $m =~ s/^(0)*//; }
656
if ($d) { $d =~ s/^(0)*//; }
657
658
if ($y < 1) { $y = 1; }
659
if ($y > 9999) { $y = 9999; }
660
661
my $rv = 28;
662
663
# adjust according to if $y is a leap year
664
my $rem4 = $y % 4;
665
my $rem100 = $y % 100;
666
my $rem400 = $y % 400;
667
my $isLeap = 0;
668
669
if ($rem4 == 0) {
670
if ($rem100 == 0) {
671
if ($rem400 == 0) { $isLeap = 1; }
672
} else {
673
$isLeap = 1;
674
}
675
}
676
677
if ($isLeap) { $rv++; }
678
679
return $rv; # the number of days for february in the specified year
680
#usage: my $num_feb_days = get_february_days("1976-01-19");
681
}
682
683
##############################
684
sub get_month_days($) {
685
#*
686
# gets the number of days in a month from a given date
687
#*
688
my ($date) = @_; # a date (eg: 1976-01-19)
689
my $rv = 0;
690
my @date = split("-", $date);
691
692
if (@date >= 2) {
693
my ($y, $m) = @date;
694
# strip all leading zeros
695
$y =~ s/^(0)*//; # sure, why not, right?
696
$m =~ s/^(0)*//;
697
if (not $m) { $m = 1; }
698
if ($y < 1) { $y = 1; }
699
if ($y > 9999) { $y = 9999; }
700
if ($m < 1) { $m = 1; }
701
if ($m > 12) { $m = 12; }
702
703
if ($m == 2) {
704
$rv = get_february_days($y);
705
}
706
elsif ($m == 4 or
707
$m == 6 or
708
$m == 9 or
709
$m == 11) {
710
$rv = 30;
711
} else {
712
$rv = 31;
713
}
714
}
715
716
return $rv; # the number of days in a month from a given date
717
#usage: my $mdays = get_month_days("1976-01-19");
718
}
719
720
##############################
721
sub add_date($$$) {
722
#*
723
# $start_date must take the format of yyyy-m|mm-d|dd (eg: 1976-01-19 or 1867-7-1)
724
# adds a specified # of either days, months, or years to a given date
725
# if final result of date calculation yields $y > 9999, $y = 9999
726
# $date will be set to 9999-12-31
727
# $type must be "d", "m", or "y"
728
# this function is not totally accurate when passing in a negative $count
729
# although, it seems -1 day at a time might work :p
730
#*
731
my ($start_date, $count, $type) = @_; # must be in the format of yyyy-m|mm-d|dd && number of (days,months,years) we're adding && assign "d", "m", or "y"
732
my $rv = 0;
733
734
my ($y, $m, $d) = split("-", $start_date);
735
# strip all leading zeros
736
$y =~ s/^(0)*//; # sure, why not, right?
737
$m =~ s/^(0)*//;
738
$d =~ s/^(0)*//;
739
740
my $mdays = get_month_days($start_date);
741
742
if ($type eq "d") {
743
# just add $count to $d
744
# then, while $d is > $mdays, keep adding months and years until $d < $mdays
745
$d += $count;
746
while ($d > $mdays) {
747
$d -= $mdays;
748
$m++;
749
if ($m > 12) {
750
$m = 1;
751
$y++;
752
}
753
754
$mdays = get_month_days("$y-$m-$d");
755
}
756
} elsif ($type eq "m") {
757
# just add $count to $m
758
# while $m > 12, subtract 12 from $m, and add one to $y
759
my $start_month = $m;
760
$m += $count;
761
while ($m > 12) {
762
$m -= 12;
763
$y++;
764
}
765
} else {
766
# just add $count to $y
767
$y += $count;
768
}
769
770
# if the calculated month is february
771
# AND
772
# the calculated day is greater than the # of days in february
773
if ($m eq 2 and $d > get_february_days($y)) {
774
$m += 1;
775
$d = $d - $mdays;
776
}
777
778
if ($y < 1) { $y = 1; } if ($y > 9999) { $y = 9999; }
779
if ($m < 1) { $m = 1; } if ($m > 12) { $m = 12; }
780
if ($d < 1) { $d = 1; } if ($d > $mdays) { $m = $mdays; }
781
$m = Bc_misc::add_zeros($m);
782
$d = Bc_misc::add_zeros($d);
783
784
$rv = "$y-$m-$d";
785
786
return $rv; # 0, or the new date
787
#usage: my $new_data = add_date(get_today("db", 1), 10, "m");
788
}
789
790
##############################
791
sub minus_date($$$) {
792
#*
793
# $start_date must take the format of [yyyy]-m|mm-[d|dd]
794
# (eg: 1976-01-19 or 1867-7-1)
795
# subtracts a specified # of either days, months, or years to
796
# a given date. if the final result of the date calculation returns
797
# $y < 1, $y = 0001 and $date will be set to 0001-01-01
798
# $type must be "d", "m", or "y"
799
# this function is not accurate when passing in a negative $count
800
# so, it won't let you do it.
801
#*
802
my ($start_date, $amount, $type) = @_; # must be in the format of yyyy-m|mm-d|dd && number of (days,months,years) to subtract && assign "d", "m", or "y"
803
my $rv = 0;
804
805
if ($amount > 0) {
806
my ($y, $m, $d) = split("-", $start_date);
807
# strip all leading zeros
808
$y =~ s/^(0)*//; # sure, why not, right?
809
$m =~ s/^(0)*//;
810
$d =~ s/^(0)*//;
811
812
my $mdays = get_month_days($start_date);
813
my $daycount = 0;
814
my $day_date = $start_date;
815
816
if ($type eq "d") {
817
# this is the tricky bit, so...can we cheat, and loop the
818
# "add_date" function, one day at a time, passing in -1 for the $count? lol
819
# yup, we can, as it seems to return a correct date. we shall see!
820
while ($daycount < $amount) {
821
$day_date = add_date($day_date, -1, "d");
822
$daycount++;
823
}
824
825
($y, $m, $d) = split("-", $day_date);
826
$y =~ s/^(0)*//; # sure, why not, right?
827
$m =~ s/^(0)*//;
828
$d =~ s/^(0)*//;
829
} elsif ($type eq "m") {
830
# just subtract $count from $m
831
# while $m < 1, add 12 to $m, and subtract one from $y
832
my $start_month = $m;
833
$m -= $amount;
834
while ($m < 1) {
835
$m += 12;
836
$y--;
837
}
838
} else {
839
# just subtract $count from $y
840
$y -= $amount;
841
}
842
843
# if the calculated month is february
844
# AND
845
# the calculated day is greater than the # of days in february
846
if ($m eq 2 and $d > get_february_days($y)) {
847
$m += 1;
848
$d = $d - $mdays;
849
}
850
851
if ($y < 1) { $y = 1; } if ($y > 9999) { $y = 9999; }
852
if ($m < 1) { $m = 1; } if ($m > 12) { $m = 12; }
853
if ($d < 1) { $d = 1; } if ($d > $mdays) { $m = $mdays; }
854
$m = Bc_misc::add_zeros($m);
855
$d = Bc_misc::add_zeros($d);
856
857
$rv = "$y-$m-$d";
858
} else {
859
$rv = $start_date;
860
}
861
862
return $rv; # 0, or the new date
863
#usage: my $new_date = minus_date(get_today("db", 1), 10, "m");
864
}
865
866
##############################
867
sub isNew($;$) {
868
#*
869
# to determine if a date is "older" than $r days or not
870
# eg: 2019-03-31 - 7 days = 2019-03-
871
#*
872
my ($d, $r) = @_; # a date && a range (optional, default = 7 days)
873
if (not $r) { $r = 7; }
874
my $rv = 0;
875
my $newDate = add_date($d, $r, "d");
876
if (isAfterToday($newDate) or $newDate eq get_today("db")) { $rv = 1; }
877
878
return $rv; # 1 if within a week, or 0 if not
879
#usage: if (isNew($ustats->{enrolled})) { print "greetings new enrollee!"; }
880
}
881
882
##############################
883
sub isAfterToday($) {
884
#*
885
# to determine if a given date comes AFTER today's date
886
#*
887
my ($date) = @_; # a date (like 1976-01-19)
888
my $rv = 0;
889
my ($y, $m, $d) = split("-", get_today("db", 1)); # today's year, month, day
890
my ($gy, $gm, $gd) = split("-", $date); # g means given
891
892
if ($gy > $y) {
893
$rv = 1;
894
} else {
895
# means the given year is either equal to or lesser than this year
896
if ($gy eq $y) {
897
# check if given month is greater than this month
898
if ($gm > $m) {
899
$rv = 1;
900
} else {
901
# means the given month is either equal to or lesser than this year
902
if ($gd > $d) {
903
$rv = 1;
904
}
905
}
906
}
907
}
908
909
return $rv; # 0 if not after today or 1 if it is after today
910
#usage: if (isAfterToday("1976-01-19")) { return "date is after today"; }
911
}
912
913
##############################
914
sub isAfterDate($$) {
915
#*
916
# to determine if a given date is after another given date
917
#*
918
my ($after, $date) = @_; # "after" date && date to compare against
919
my $rv = 0;
920
921
my ($a_y, $a_m, $a_d) = split("-", $after);
922
my ($d_y, $d_m, $d_d) = split("-", $date);
923
924
# remove leading zeros?
925
$a_y =~ s/^(0)*//;
926
$a_m =~ s/^(0)*//;
927
$a_d =~ s/^(0)*//;
928
$d_y =~ s/^(0)*//;
929
$d_m =~ s/^(0)*//;
930
$d_d =~ s/^(0)*//;
931
932
# 2018-12-06 > 2019-01-19?
933
if ($a_y > $d_y) {
934
$rv = 1;
935
} elsif ($a_y == $d_y) {
936
if ($a_m > $d_m) {
937
$rv = 1;
938
} elsif ($a_m == $d_m) {
939
if ($a_d > $d_d) {
940
$rv = 1;
941
}
942
}
943
}
944
945
return $rv; # 0 if not after, 1 if on or after $date
946
#usage: if (isAfterDate("2019-12-05", "2019-01-01")) { ... };
947
}
948
949
##############################
950
sub isBeforeDate($$) {
951
#*
952
# to determine if a given date is on or before another given date
953
#*
954
my ($before, $date) = @_; # "before" date && date to compare against
955
my $rv = 0;
956
957
my ($b4_y, $b4_m, $b4_d) = split("-", $before);
958
my ($d_y, $d_m, $d_d) = split("-", $date);
959
960
# remove leading zeros?
961
$b4_y =~ s/^(0)*//;
962
$b4_m =~ s/^(0)*//;
963
$b4_d =~ s/^(0)*//;
964
$d_y =~ s/^(0)*//;
965
$d_m =~ s/^(0)*//;
966
$d_d =~ s/^(0)*//;
967
968
# 2018-12-06 < 2019-01-19
969
if ($b4_y < $d_y) {
970
$rv = 1;
971
} elsif ($b4_y == $d_y) {
972
if ($b4_m < $d_m) {
973
$rv = 1;
974
} elsif ($b4_m == $d_m) {
975
if ($b4_d <= $d_d) {
976
$rv = 1;
977
}
978
}
979
}
980
981
return $rv; # 0 if not before, 1 if on or before $date
982
#usage: if (isBeforeDate("2018-12-05", "2019-01-01")) { ... };
983
}
984
985
##############################
986
sub isBeforeToday($) {
987
#*
988
# to determine if a given date comes BEFORE today's date
989
#*
990
my ($date) = @_; # a date (like 1976-01-19)
991
my $rv = 0;
992
my ($y, $m, $d) = split("-", get_today("db", 1)); # today's year, month, day
993
my ($gy, $gm, $gd) = split("-", $date); # g means given
994
995
if ($gy < $y) {
996
$rv = 1;
997
} else {
998
# means the given year is either equal to or greater than this year
999
if ($gy eq $y) {
1000
# check if given month is less than this month
1001
if ($gm < $m) {
1002
$rv = 1;
1003
} else {
1004
# means the given month is either equal to or greater than this month
1005
if ($gm eq $m) {
1006
if ($gd < $d) {
1007
$rv = 1;
1008
}
1009
}
1010
}
1011
}
1012
}
1013
1014
return $rv; # 0 if not before today or 1 if it is before today
1015
#usage: if (isBeforeToday("1976-01-19")) { return "date is before today"; }
1016
}
1017
1018
##############################
1019
##############################
1020
##############################
1021
##############################
1022
##############################
1023
##############################
1024
##############################
1025
##############################
1026
##############################
1027
##############################
1028
##############################
1029
##############################
1030
##############################
1031
##############################
1032
##############################
1033
##############################
1034
##############################
1035
##############################
1036
##############################
1037
##############################
1038
##############################
1039
##############################
1040
##############################
1041
##############################
1042
1043
##############################
1044
sub _tests(;$) {
1045
#*
1046
# to test all <i>Pm::Date</i> functions
1047
#*
1048
my ($extended) = @_; # show extended data (optional)
1049
my $rv = "";
1050
my $test = 0;
1051
my $test2 = 0;
1052
my $test3 = 0;
1053
1054
if ($Bc_sql::DB) {
1055
$test = "2016-03-01";
1056
my $tmp = $test;
1057
$test2 = "-1";
1058
$test3 = "d";
1059
$rv .= Html::display_debug_one("add_date(\"$tmp\", $test2, \"$test3\")", add_date($test, $test2, $test3));
1060
$test2 = "1";
1061
$test3 = "d";
1062
$rv .= Html::display_debug_one("minus_date(\"$tmp\", $test2, \"$test3\")", minus_date($test, $test2, $test3));
1063
$rv .= Html::display_debug_one("determine_zodiac(\"$test\", \"$test3\")", determine_zodiac($test, $test3));
1064
$rv .= Html::display_debug_one("expand_date(\"$test\")", expand_date($test));
1065
$test2 = 0;
1066
$rv .= Html::display_debug_one("get_DoW($test2)", get_DoW($test2));
1067
$test2 = "1976-01-19";
1068
$rv .= Html::display_debug_one("get_DoW($test2)", get_DoW($test2));
1069
$rv .= Html::display_debug_one("get_DoW_abbr($test2)", get_DoW_abbr($test2));
1070
$rv .= Html::display_debug_one("get_date()", get_date());
1071
$test2 = "db";
1072
$rv .= Html::display_debug_one("get_date(\"$test2\")", get_date($test2));
1073
$test2 = "cookie";
1074
$rv .= Html::display_debug_one("get_date(\"$test2\")", get_date($test2));
1075
$test2 = 11;
1076
$rv .= Html::display_debug_one("get_day($test2)", get_day($test2));
1077
$rv .= Html::display_debug_one("get_day(-1)", get_day(-1));
1078
$test = "2016";
1079
$rv .= Html::display_debug_one("get_february_days(\"$test\")", get_february_days($test));
1080
$test = "2000-02";
1081
$rv .= Html::display_debug_one("get_month(\"$test\")", get_month($test));
1082
$rv .= Html::display_debug_one("get_month_abbr(\"$test\")", get_month_abbr($test));
1083
$rv .= Html::display_debug_one("get_month_days(\"$test\")", get_month_days($test));
1084
$rv .= Html::display_debug_one("get_time(\"$test\", $test2)", get_time($test, $test2));
1085
1086
$rv .= Html::display_debug_one("get_today(\"$test3\", $test2)", get_today($test3, $test2));
1087
$test3 = "dow";
1088
$rv .= Html::display_debug_one("get_today(\"$test3\")", get_today($test3));
1089
$rv .= Html::display_debug_one("get_today(\"$test3\", $test2)", get_today($test3, $test2));
1090
1091
$rv .= Html::display_debug_one("get_today_cookie_style()", get_today_cookie_style());
1092
$rv .= Html::display_debug_one("get_year()", get_year());
1093
1094
$test = "2019-03-23"; # 31 - 7 = 24, for instance
1095
$rv .= Html::display_debug_one("isNew('$test')", isNew($test));
1096
1097
$test = "2017-08-06";
1098
$rv .= Html::display_debug_one("isAfterToday('$test')", isAfterToday($test));
1099
$rv .= Html::display_debug_one("isBeforeToday('$test')", isBeforeToday($test));
1100
$test = "2019-02-20";
1101
$test2 = "2019-02-19";
1102
$rv .= Html::display_debug_one("isBeforeDate('$test', '$test2')", isBeforeDate($test, $test2));
1103
$test2 = "2019-02-19";
1104
$rv .= Html::display_debug_one("isAfterDate('$test', '$test2')", isAfterDate($test, $test2));
1105
$test = "1999-01-01";
1106
$rv .= Html::display_debug_one("valid_date(\"$test\")", valid_date($test));
1107
1108
# end if ($Bc_sql::DB)
1109
} else {
1110
$rv .= "DB connection error!<br>\n";
1111
# end else of if ($Bc_sql::DB)
1112
}
1113
1114
return $rv; # 0 on failure, or a scalar
1115
#usage: print _tests();
1116
}
1117
1118
##############################
1119
1120
1;