archive.pl 1.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152
  1. # Copyright (C) 2007 Alex Schroeder <alex@emacswiki.org>
  2. #
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 2 of the License, or
  6. # (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program; if not, write to the
  15. # Free Software Foundation, Inc.
  16. # 59 Temple Place, Suite 330
  17. # Boston, MA 02111-1307 USA
  18. use strict;
  19. use v5.10;
  20. AddModuleDescription('archive.pl', 'Archive Extension');
  21. our ($q);
  22. *OldArchiveGetHeader = \&GetHeader;
  23. *GetHeader = \&NewArchiveGetHeader;
  24. # this assumes that *all* calls to GetHeader will print!
  25. sub NewArchiveGetHeader {
  26. my ($id) = @_;
  27. print OldArchiveGetHeader(@_);
  28. my %dates = ();
  29. for (AllPagesList()) {
  30. $dates{$1}++ if /^(\d\d\d\d-\d\d)-\d\d/;
  31. }
  32. print $q->div({-class=>'archive'},
  33. $q->p($q->span(T('Archive:')),
  34. map {
  35. my $key = $_;
  36. my ($year, $month) = split(/-/, $key);
  37. if (defined(&month_name)) {
  38. ScriptLink('action=collect;match=' . UrlEncode("^$year-$month"),
  39. month_name($month) . " $year ($dates{$key})");
  40. } else {
  41. ScriptLink('action=index;match=' . UrlEncode("^$year-$month"),
  42. "$year-$month ($dates{$key})");
  43. }
  44. } sort { $b <=> $a } keys %dates));
  45. return '';
  46. }