oddmuse/modules/calendar.pl

# Copyright (C) 2004–2023  Alex Schroeder <alex@gnu.org>
# Copyright (C) 2006  Ingo Belka
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use v5.10;

AddModuleDescription('calendar.pl', 'Calendar Extension');

our ($q, %Page, %Action, $Now, $OpenPageName, $CollectingJournal, $FreeLinkPattern, @MyRules);
our ($CalendarOnEveryPage, $CalAsTable, $CalStartMonday);

$CalendarOnEveryPage = 0;   # 1=on every page is a month-div situated in the header, use css to control
                            # 2=this month and the previous month; 3=this, previous and next month
$CalAsTable = 0;            # 0=every month-div is "free", 1=every month-div is caught in a table, use css to control
$CalStartMonday = 0;        # 0=week starts with Su, 1=week starts with Mo

*OldCalendarGetHeader = \&GetHeader;
*GetHeader = \&NewCalendarGetHeader;

sub NewCalendarGetHeader {
  my $header = OldCalendarGetHeader(@_);
  return $header unless $CalendarOnEveryPage;
  my $action = GetParam('action', 'browse');
  return $header if grep(/^$action$/, ('calendar', 'edit'));
  my $cal;
  my ($sec, $min, $hour, $mday, $mon, $year) = localtime($Now);
  $year += 1900;
  # $mon is 0 based and thus good for previous month
  if ($mon < 1) { $year -= 1; $mon += 12; };
  $cal .= Cal($year, $mon) if $CalendarOnEveryPage > 1;
  # the current month
  $mon += 1;
  if ($mon > 12) { $year += 1; $mon -= 12; };
  $cal .= Cal($year, $mon) if $CalendarOnEveryPage;
  # the next month
  $mon += 1;
  if ($mon > 12) { $year += 1; $mon -= 12; };
  $cal .= Cal($year, $mon) if $CalendarOnEveryPage > 2;
  # insert calendars before header div
  $header =~ s!<div class="header">!<div class="cal">$cal</div><div class="header">!;
  return $header;
}

sub Cal {
  my ($year, $mon, $unlink_year, $id) = @_; # example: 2004, 12
  $id = FreeToNormal($id);
  my ($sec_now, $min_now, $hour_now, $mday_now, $mon_now, $year_now) = localtime($Now);
  $mon_now += 1;
  $mon = $mon_now unless $mon;
  $year_now += 1900;
  $year = $year_now unless $year;
  if ($year < 1) {
    return $q->p(T('Illegal year value: Use 0001-9999'));
  }
  my @pages = AllPagesList();
  my $cal = draw_month($mon, $year);
  $cal =~ s{ ( ?\d{1,2})\b}{{
    my $day = $1;
    my $date = sprintf("%d-%02d-%02d", $year, $mon, $day);
    my $re = "^$date";
    $re .= ".*$id" if $id;
    my $page = $date;
    $page .= "_$id" if $id;
    my $class = '';
    $class .= ' today' if $day == $mday_now and $mon == $mon_now and $year == $year_now;
    my @matches = grep(/$re/, @pages);
    my $link = ' ';
    if (@matches == 0) { # not using GetEditLink because of $class
      $link .= ScriptLink('action=edit;id=' . UrlEncode($page), $day, 'edit' . $class);
    } elsif (@matches == 1) { # not using GetPageLink because of $class
      $link .= ScriptLink($matches[0], $day, 'local exact' . $class);
    } else {
      $link .= ScriptLink('action=collect;match=' . UrlEncode($re), $day,  'local collection' . $class);
    }
    $link;
  }}eg;
  $cal =~ s{(\S+) (\d\d\d\d)}{{
    my ($month_text, $year_text) = ($1, $2);
    my $date = sprintf("%d-%02d", $year, $mon);
    if ($unlink_year) {
      $q->span({-class=>'title'}, ScriptLink('action=collect;match=%5e' . $date,
					     "$month_text $year_text",  'local collection month'));
    } else {
      $q->span({-class=>'title'}, ScriptLink('action=collect;match=%5e' . $date,
					     $month_text,  'local collection month') . ' '
	       . ScriptLink('action=calendar;year=' . $year,
			    $year_text,  'local collection year'));
    }
  }}e;
  return "<div class=\"month\"><pre>$cal</pre></div>";
}

$Action{collect} = \&DoCollect;

# inspired by journal
sub DoCollect {
  my $id = shift;
  my $match = GetParam('match', '');
  my $search = GetParam('search', '');
  ReportError(T('The match parameter is missing.')) unless $match or $search;
  print GetHeader('', Ts('Page Collection for %s', $match||$search), '');
  my @pages = Matched($match, $search ? SearchTitleAndBody($search) : AllPagesList());
  if (!$CollectingJournal) {
    $CollectingJournal = 1;
    # Now save information required for saving the cache of the current page.
    local (%Page, $OpenPageName);
    print $q->start_div({-class=>'content journal collection'});
    PrintAllPages(1, 1, undef, undef, @pages);
    print $q->end_div();
  }
  $CollectingJournal = 0;
  PrintFooter();
}

push(@MyRules, \&CalendarRule);

sub CalendarRule {
  if (/\G(calendar:(\d\d\d\d))/cg) {
    my $oldpos = pos;
    Clean(CloseHtmlEnvironments());
    Dirty($1);
    PrintYearCalendar($2);
    pos = $oldpos;
    return AddHtmlEnvironment('p');
  } elsif (/\G(month:(\d\d\d\d)-(\d\d))/cg) {
    my $oldpos = pos;
    Clean(CloseHtmlEnvironments());
    Dirty($1);
    print $q->div({-class => 'cal'}, Cal($2, $3));
    pos = $oldpos;
    return AddHtmlEnvironment('p');
  } elsif (/\G(month:([+-]\d\d?))/cg
	  or /\G(\[\[month:([+-]\d\d?) $FreeLinkPattern\]\])/cg) {
    my $oldpos = pos;
    Clean(CloseHtmlEnvironments());
    Dirty($1);
    my $delta = $2;
    my $id = $3;
    my ($sec, $min, $hour, $mday, $mon, $year) = localtime($Now);
    $year += 1900;
    $mon += 1 + $delta;
    while ($mon < 1) { $year -= 1; $mon += 12; };
    while ($mon > 12) { $year += 1; $mon -= 12; };
    print $q->div({-class => 'cal'}, Cal($year, $mon, undef, $id));
    pos = $oldpos;
    return AddHtmlEnvironment('p');
  }
  return;
}

sub PrintYearCalendar {
  my $year = shift;
  print $q->p({-class=>'nav'},
	      ScriptLink('action=calendar;year=' . ($year-1), T('Previous')),
	      '|',
	      ScriptLink('action=calendar;year=' . ($year+1), T('Next')));
  if ($CalAsTable) {
      print '<table><tr>';
      for my $mon (1..12) {
        print '<td>'.Cal($year, $mon, 1).'</td>';
        if ($mon == 3 or $mon == 6 or $mon == 9) {
            print '</tr><tr>';
        }
      }
      print '</tr></table>';
  } else {
      for my $mon (1..12) {
        print Cal($year, $mon, 1);
      }
  }
}

$Action{calendar} = \&DoYearCalendar;

sub DoYearCalendar {
  my ($sec, $min, $hour, $mday, $mon, $year) = localtime($Now);
  $year += 1900;
  $year = GetParam('year', $year);

  print GetHeader('', Ts('Calendar %s', $year), '');
  print $q->start_div({-class=>'content cal year'});
  PrintYearCalendar($year);
  print $q->end_div();
  PrintFooter();
}

sub draw_month {
    my $month = shift;
    my $year = shift;
    my @weekday = (T('Su'), T('Mo'), T('Tu'), T('We'),
		     T('Th'), T('Fr'), T('Sa'));
    my ($day, $col, $monthdays, $monthplus, $mod);
    my $weekday = zeller(1,$month,$year);
    # select the starting day for the week
    if ($CalStartMonday){
        push @weekday, shift @weekday;
        if ($weekday) {
            $weekday = $weekday -1;
        } else {
            $weekday = 6;
        }
    }
    my $start = 1 - $weekday;
    my $space_count = int((21 - length(month_name($month).' '.sprintf("%04u",$year)))/2 + 0.5);
    # the Cal()-sub needs a 4 digit year working right
    my $output = (' ' x $space_count).month_name($month).' '.sprintf("%04u",$year)."\n";
    $col = 0;
    $monthdays = &month_days($month,&leap_year($year));
    if ((($monthdays-$start) < 42) and (($monthdays-$start) > 35)) {
        $monthplus=41 - ($monthdays-$start);
    } elsif ((($monthdays-$start)<35) and (($monthdays-$start)>28)) {
        $monthplus=34 - ($monthdays-$start);
    } else {
        $monthplus=0;
    }
    $output .= join('', map {" ".$_} @weekday);
    $output .= "\n";
    for ($day=$start;$day<=$monthdays+$monthplus;$day++) {
        $col++;
        if (($day < 1) or ($day>$monthdays)) {
            $output .= '   ';
        } else {
            $output .= sprintf("%3d", $day);
        }
        $mod=($col/7)-int($col/7);
        if ($mod == 0) {
            $output .= "\n";
        }
        if ($year==1582 and $month==10 and $day==4) {
            $day=14;
        }
    }
    $output .= "\n" x (8 - ($output =~ tr/\n//)); # every month has to have 8 lines as output
    return $output;
}

# formula of Zeller (Julius Christian Johannes Zeller * 1822, + 1899) for countig the day of week
# only works for all years greater then 0 and can handle 1582 the year Pope Gregor has changed the
# calculation of times from the Julian calendar to the Gregorian calendar
sub zeller {
    my $t = shift;
    my $m = shift;
    my $year = shift;
    my ($h,$j,$w);
    $h=int($year/100);
    $j=$year%100;
    if ($m<3) {
        $m = $m+10;
        if ($j==0) {
            $j=99;
            $h=$h-1;
        } else {
            $j=$j-1;
        }
    } else {
        $m=$m-2;
    }
    if (($year > 0) and ($year < 1582)) {
        $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + 5 - $h;
    } elsif ($year==1582) {
        if ($m > 10) {
            $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + 5 - $h;
        } elsif ($m==8) {
            if ($t>=1 and $t<=4) {
                $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + 5 - $h;
            } elsif ($t>=15) {
                $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + int($h/4) - (2*$h);
            }
        } elsif ($m <= 10) {
            $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + int($h/4) - (2*$h);
        }
    } elsif ($year > 1582) {
        $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + int($h/4) - (2*$h);
    }
    if (($w % 7) >= 0) {
        $w = $w % 7;
    } else {
        $w = 7 - (-1 * ($w % 7));
    }
    return $w;
}

sub leap_year {
    my $year = shift;

    if ((($year % 4)==0) and !((($year % 100)==0) and (($year % 400) != 0))) {
        return 1;
    } else {
        return 0;
    }
}

sub month_days {
    my $month = shift;
    my $leap_year = shift;
    my @month_days = (31,28,31,30,31,30,31,31,30,31,30,31);
    if (($month == 2) and $leap_year) {
        return $month_days[$month - 1] + 1;
    } else {
        return $month_days[$month - 1];
    }
}

sub month_name {
    my $month = shift;
    my @month_name = (T('January'), T('February'), T('March'), T('April'),
		      T('May'), T('June'), T('July'), T('August'),
		      T('September'), T('October'), T('November'),
		      T('December'));
    return $month_name[$month-1];
}