modules/calendar.pl

   1 # Copyright (C) 2004, 2005, 2006  Alex Schroeder <alex@emacswiki.org>
   2 # Copyright (C) 2006  Ingo Belka
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the
  16 #    Free Software Foundation, Inc.
  17 #    59 Temple Place, Suite 330
  18 #    Boston, MA 02111-1307 USA
  19
  20 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/calendar.pl">calendar.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Calendar_Extension">Calendar Extension</a></p>';
  21
  22 use vars qw($CalendarOnEveryPage $CalAsTable $CalStartMonday);
  23
  24 $CalendarOnEveryPage = 0;   # 1=on every page is a month-div situated in the header, use css to control
  25 $CalAsTable = 0;            # 0=every month-div is "free", 1=every month-div is caught in a table, use css to control
  26 $CalStartMonday = 0;        # 0=week starts with Su, 1=week starts with Mo
  27
  28 *OldCalendarGetHeader = *GetHeader;
  29 *GetHeader = *NewCalendarGetHeader;
  30
  31 sub NewCalendarGetHeader {
  32   my $header = OldCalendarGetHeader(@_);
  33   return $header unless $CalendarOnEveryPage;
  34   my $action = GetParam('action', 'browse');
  35   return $header if grep(/^$action$/, ('calendar', 'edit'));
  36   my $cal = Cal();
  37   $header =~ s/<div class="header">/$cal<div class="header">/;
  38   return $header;
  39 }
  40
  41 sub Cal {
  42   my ($year, $mon, $unlink_year, $id) = @_; # example: 2004, 12
  43   $id = FreeToNormal($id);
  44   my ($sec_now, $min_now, $hour_now, $mday_now, $mon_now, $year_now) = localtime($Now);
  45   $mon_now += 1;
  46   $mon = $mon_now unless $mon;
  47   $year_now += 1900;
  48   $year = $year_now unless $year;
  49   if ($year < 1) {
  50     return $q->p(T('Illegal year value: Use 0001-9999'));
  51   }
  52   my @pages = AllPagesList();
  53   my $cal = draw_month($mon, $year);
  54   $cal =~ s{( {1,2}\d{1,2})\b}{{
  55     my $day = $1;
  56     my $date = sprintf("%d-%02d-%02d", $year, $mon, $day);
  57     my $re = "^$date";
  58     $re .= ".*$id" if $id;
  59     my $page = $date;
  60     $page .= "_$id" if $id;
  61     my $class = '';
  62     $class .= ' today' if $day == $mday_now and $mon == $mon_now and $year == $year_now;
  63     my @matches = grep(/$re/, @pages);
  64     my $link;
  65     if (@matches == 0) { # not using GetEditLink because of $class
  66       $link = ScriptLink('action=edit;id=' . UrlEncode($page), $day, 'edit' . $class);
  67     } elsif (@matches == 1) { # not using GetPageLink because of $class
  68       $link = ScriptLink($matches[0], $day, 'local exact' . $class);
  69     } else {
  70       $link = ScriptLink('action=collect;match=' . UrlEncode($re), $day,  'local collection' . $class);
  71     }
  72     $link;
  73   }}ge;
  74   $cal =~ s{(\S+) (\d\d\d\d)}{{
  75     my ($month_text, $year_text) = ($1, $2);
  76     my $date = sprintf("%d-%02d", $year, $mon);
  77     if ($unlink_year) {
  78       $q->span({-class=>'title'}, ScriptLink('action=collect;match=%5e' . $date,
  79                                              "$month_text $year_text",  'local collection month'));
  80     } else {
  81       $q->span({-class=>'title'}, ScriptLink('action=collect;match=%5e' . $date,
  82                                              $month_text,  'local collection month') . ' '
  83                . ScriptLink('action=calendar;year=' . $year,
  84                             $year_text,  'local collection year'));
  85     }
  86   }}e;
  87   return "<div class=\"cal month\"><pre>$cal</pre></div>";
  88 }
  89
  90 $Action{collect} = \&DoCollect;
  91
  92 # inspired by journal
  93 sub DoCollect {
  94   my $id = shift;
  95   my $match = GetParam('match', '');
  96   my $search = GetParam('search', '');
  97   ReportError(T('The match parameter is missing.')) unless $match or $search;
  98   print GetHeader('', Ts('Page Collection for %s', $match||$search), '');
  99   my @pages = (grep(/$match/, $search
 100                     ? SearchTitleAndBody($search)
 101                     : AllPagesList()));
 102   if (!$CollectingJournal) {
 103     $CollectingJournal = 1;
 104     # Now save information required for saving the cache of the current page.
 105     local (%Page, $OpenPageName);
 106     print $q->start_div({-class=>'content journal collection'});
 107     PrintAllPages(1, 1, undef, @pages);
 108     print $q->end_div();
 109   }
 110   $CollectingJournal = 0;
 111   PrintFooter();
 112 }
 113
 114 push(@MyRules, \&CalendarRule);
 115
 116 sub CalendarRule {
 117   if (/\G(calendar:(\d\d\d\d))/gc) {
 118     my $oldpos = pos;
 119     Clean(CloseHtmlEnvironments());
 120     Dirty($1);
 121     PrintYearCalendar($2);
 122     pos = $oldpos;
 123     return AddHtmlEnvironment('p');
 124   } elsif (/\G(month:(\d\d\d\d)-(\d\d))/gc) {
 125     my $oldpos = pos;
 126     Clean(CloseHtmlEnvironments());
 127     Dirty($1);
 128     print Cal($2, $3);
 129     pos = $oldpos;
 130     return AddHtmlEnvironment('p');
 131   } elsif (/\G(month:([+-]\d\d?))/gc
 132           or /\G(\[\[month:([+-]\d\d?) $FreeLinkPattern\]\])/gc) {
 133     my $oldpos = pos;
 134     Clean(CloseHtmlEnvironments());
 135     Dirty($1);
 136     my $delta = $2;
 137     my $id = $3;
 138     my ($sec, $min, $hour, $mday, $mon, $year) = localtime($Now);
 139     $year += 1900;
 140     $mon += 1 + $delta;
 141     while ($mon < 1) { $year -= 1; $mon += 12; };
 142     while ($mon > 12) { $year += 1; $mon -= 12; };
 143     print Cal($year, $mon, undef, $id);
 144     pos = $oldpos;
 145     return AddHtmlEnvironment('p');
 146   }
 147   return undef;
 148 }
 149
 150 sub PrintYearCalendar {
 151   my $year = shift;
 152   print $q->p({-class=>nav},
 153               ScriptLink('action=calendar;year=' . ($year-1), T('Previous')),
 154               '|',
 155               ScriptLink('action=calendar;year=' . ($year+1), T('Next')));
 156   if ($CalAsTable) {
 157       print '<table><tr>';
 158       for $mon ((1..12)) {
 159         print '<td>'.Cal($year, $mon, 1).'</td>';
 160         if (($mon==3) or ($mon==6) or ($mon==9)) {
 161             print '</tr><tr>';
 162         }
 163       }
 164       print '</tr></table>';
 165   } else {
 166       for $mon ((1..12)) {
 167         print Cal($year, $mon, 1);
 168       }
 169   }
 170 }
 171
 172 $Action{calendar} = \&DoYearCalendar;
 173
 174 sub DoYearCalendar {
 175   my ($sec, $min, $hour, $mday, $mon, $year) = localtime($Now);
 176   $year += 1900;
 177   $year = GetParam('year', $year);
 178
 179   print GetHeader('', Ts('Calendar %s', $year), '');
 180   print $q->start_div({-class=>'content cal year'});
 181   PrintYearCalendar($year);
 182   print $q->end_div();
 183   PrintFooter();
 184 }
 185
 186 sub draw_month {
 187     my $month = shift;
 188     my $year = shift;
 189     my @weekday = (T('Su'), T('Mo'), T('Tu'), T('We'),
 190                      T('Th'), T('Fr'), T('Sa'));
 191     my ($day, $col, $monthdays, $monthplus, $mod);
 192     my $weekday = zeller(1,$month,$year);
 193     # select the starting day for the week
 194     if ($CalStartMonday){
 195         push @weekday, shift @weekday;
 196         if ($weekday) {
 197             $weekday = $weekday -1;
 198         } else {
 199             $weekday = 6;
 200         }
 201     }
 202     my $start = 1 - $weekday;
 203     my $space_count = int((21 - length(month_name($month).' '.sprintf("%04u",$year)))/2 + 0.5);
 204     # the Cal()-sub needs a 4 digit year working right
 205     my $output = (' ' x $space_count).month_name($month).' '.sprintf("%04u",$year)."\n";
 206     $col = 0;
 207     $monthdays = &month_days($month,&leap_year($year));
 208     if ((($monthdays-$start) < 42) and (($monthdays-$start) > 35)) {
 209         $monthplus=41 - ($monthdays-$start);
 210     } elsif ((($monthdays-$start)<35) and (($monthdays-$start)>28)) {
 211         $monthplus=34 - ($monthdays-$start);
 212     } else {
 213         $monthplus=0;
 214     }
 215     $output .= join('', map {" ".$_} @weekday);
 216     $output .= "\n";
 217     for ($day=$start;$day<=$monthdays+$monthplus;$day++) {
 218         $col++;
 219         if (($day < 1) or ($day>$monthdays)) {
 220             $output .= '   ';
 221         } else {
 222             $output .= sprintf("%3d", $day);
 223         }
 224         $mod=($col/7)-int($col/7);
 225         if ($mod == 0) {
 226             $output .= "\n";
 227         }
 228         if ($year==1582 and $month==10 and $day==4) {
 229             $day=14;
 230         }
 231     }
 232     $output .= "\n" x (8 - ($output =~ tr/\n//)); # every month has to have 8 lines as output
 233     return $output;
 234 }
 235
 236 # formula of Zeller (Julius Christian Johannes Zeller * 1822, + 1899) for countig the day of week
 237 # only works for all years greater then 0 and can handle 1582 the year Pope Gregor has changed the
 238 # calculation of times from the Julian calendar to the Gregorian calendar
 239 sub zeller {
 240     my $t = shift;
 241     my $m = shift;
 242     my $year = shift;
 243     my ($h,$j,$w);
 244     $h=int($year/100);
 245     $j=$year%100;
 246     if ($m<3) {
 247         $m = $m+10;
 248         if ($j==0) {
 249             $j=99;
 250             $h=$h-1;
 251         } else {
 252             $j=$j-1;
 253         }
 254     } else {
 255         $m=$m-2;
 256     }
 257     if (($year > 0) and ($year < 1582)) {
 258         $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + 5 - $h;
 259     } elsif ($year==1582) {
 260         if ($m > 10) {
 261             $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + 5 - $h;
 262         } elsif ($m==8) {
 263             if ($t>=1 and $t<=4) {
 264                 $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + 5 - $h;
 265             } elsif ($t>=15) {
 266                 $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + int($h/4) - (2*$h);
 267             }
 268         } elsif ($m <= 10) {
 269             $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + int($h/4) - (2*$h);
 270         }
 271     } elsif ($year > 1582) {
 272         $w = $t + int((2.61 * $m) - 0.2) + $j + int($j/4) + int($h/4) - (2*$h);
 273     }
 274     if (($w % 7) >= 0) {
 275         $w = $w % 7;
 276     } else {
 277         $w = 7 - (-1 * ($w % 7));
 278     }
 279     return $w;
 280 }
 281
 282 sub leap_year {
 283     my $year = shift;
 284
 285     if ((($year % 4)==0) and !((($year % 100)==0) and (($year % 400) != 0))) {
 286         return 1;
 287     } else {
 288         return 0;
 289     }
 290 }
 291
 292 sub month_days {
 293     my $month = shift;
 294     my $leap_year = shift;
 295     my @month_days = (31,28,31,30,31,30,31,31,30,31,30,31);
 296     if (($month == 2) and $leap_year) {
 297         return $month_days[$month - 1] + 1;
 298     } else {
 299         return $month_days[$month - 1];
 300     }
 301 }
 302
 303 sub month_name {
 304     my $month = shift;
 305     my @month_name = (T('January'), T('February'), T('March'), T('April'),
 306                       T('May'), T('June'), T('July'), T('August'),
 307                       T('September'), T('October'), T('November'),
 308                       T('December'));
 309     return $month_name[$month-1];
 310 }