| 1 | #!/usr/bin/perl |
| 2 | ##--------------------------------------------------------------------------## |
| 3 | ## File: |
| 4 | ## $Id: mnav.cgi.in.dist,v 1.5 2002/10/17 03:11:31 ehood Exp $ |
| 5 | ## Author: |
| 6 | ## Earl Hood earl@earlhood.com |
| 7 | ## Description: |
| 8 | ## POD at end-of-file. |
| 9 | ##--------------------------------------------------------------------------## |
| 10 | ## Copyright (C) 2001-2002 Earl Hood <earl@earlhood.com> |
| 11 | ## |
| 12 | ## This program is free software; you can redistribute it and/or modify |
| 13 | ## it under the terms of the GNU General Public License as published by |
| 14 | ## the Free Software Foundation; either version 2 of the License, or |
| 15 | ## (at your option) any later version. |
| 16 | ## |
| 17 | ## This program is distributed in the hope that it will be useful, |
| 18 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 19 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 20 | ## GNU General Public License for more details. |
| 21 | ## |
| 22 | ## You should have received a copy of the GNU General Public License |
| 23 | ## along with this program; if not, write to the Free Software |
| 24 | ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA |
| 25 | ## 02111-1307, USA |
| 26 | ##--------------------------------------------------------------------------## |
| 27 | |
| 28 | package mnav_cgi; |
| 29 | |
| 30 | use lib '/home/mharc/lib'; |
| 31 | |
| 32 | use CGI::Carp; |
| 33 | use MHArc::CGI; |
| 34 | |
| 35 | ############################################################################# |
| 36 | ## BEGIN: Config Section |
| 37 | ############################################################################# |
| 38 | |
| 39 | ## Full pathname to where HTML archives are located. |
| 40 | my $html_archive_root = '/home/mharc/html'; |
| 41 | |
| 42 | ## URL pathname to where HTML archives are located. |
| 43 | my $url_archive_root = '/archive/html'; |
| 44 | |
| 45 | ############################################################################# |
| 46 | ## END: Config Section |
| 47 | ############################################################################# |
| 48 | |
| 49 | ## Query argument name to contain name of archive |
| 50 | my $argname_archive = 'a'; |
| 51 | |
| 52 | ## Query argumant name to contain nav direction ('next' or 'prev') |
| 53 | my $argname_direction = 'd'; |
| 54 | |
| 55 | ## Query argument name to contain month |
| 56 | my $argname_month = 'm'; |
| 57 | |
| 58 | ## Query argument name to contain type of index |
| 59 | my $argname_type = 't'; |
| 60 | |
| 61 | MAIN: { |
| 62 | my $form = MHArc::CGI::parse_input(); |
| 63 | my $archive = $form->{$argname_archive}; |
| 64 | my $direction = $form->{$argname_direction}; |
| 65 | my $month = $form->{$argname_month}; |
| 66 | my $type = $form->{$argname_type}; |
| 67 | my $host = $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} || |
| 68 | $ENV{'SERVER_ADDR'} || 'localhost'; |
| 69 | my $port = $ENV{'SERVER_PORT'} || ""; |
| 70 | my $http = ($ENV{'HTTPS'} eq 'on') ? 'https' : 'http'; |
| 71 | if ($port && $port ne '80') { |
| 72 | $port = ":$port"; |
| 73 | } else { |
| 74 | $port = ""; |
| 75 | } |
| 76 | |
| 77 | if (($archive =~ /\.\./) || ($archive =~ /[\\\/]/)) { |
| 78 | warn qq/Fishy looking archive setting: $archive\n/; |
| 79 | MHArc::CGI::print_input_error(); |
| 80 | last MAIN; |
| 81 | } |
| 82 | if ($month !~ /^\d+(?:-\d+)?/) { |
| 83 | warn qq/Invalid month: $month\n/; |
| 84 | MHArc::CGI::print_input_error(); |
| 85 | last MAIN; |
| 86 | } |
| 87 | |
| 88 | my $server_url= "$http://$host$port"; |
| 89 | my $dir = join('/', $html_archive_root, $archive); |
| 90 | my $url = $server_url . join('/', $url_archive_root, $archive); |
| 91 | |
| 92 | local(*DIR); |
| 93 | if (!opendir(DIR, $dir)) { |
| 94 | warn qq/Unable to open "$dir": $!\n/; |
| 95 | MHArc::CGI::print_location($url); |
| 96 | last MAIN; |
| 97 | } |
| 98 | |
| 99 | my @months = sort grep { /^\d+(?:-\d+)?/ } readdir(DIR); |
| 100 | close(DIR); |
| 101 | if (scalar(@months) <= 0) { |
| 102 | # No month directories, so jump to top index |
| 103 | MHArc::CGI::print_location($url); |
| 104 | last MAIN; |
| 105 | } |
| 106 | |
| 107 | # Search for current month in listing |
| 108 | my($i); |
| 109 | for ($i=0; $i <= $#months; ++$i) { |
| 110 | last if $month eq $months[$i]; |
| 111 | } |
| 112 | # Adjust offset according to direction |
| 113 | if ($direction =~ /prev/) { --$i; } else { ++$i; } |
| 114 | if (($i < 0) || ($i > $#months)) { |
| 115 | # Hit bounds, so jump user to top index |
| 116 | MHArc::CGI::print_location($url); |
| 117 | last MAIN; |
| 118 | } |
| 119 | |
| 120 | # Redirect user to new month |
| 121 | $url .= '/' . $months[$i] . '/' . |
| 122 | ($type eq 't' ? 'threads.html' : 'index.html'); |
| 123 | MHArc::CGI::print_location($url) |
| 124 | } |
| 125 | |
| 126 | ######################################################################## |
| 127 | __END__ |
| 128 | |
| 129 | =head1 NAME |
| 130 | |
| 131 | mnav.cgi - mharc CGI program to navigate between period indexes |
| 132 | |
| 133 | =head1 SYNOPSIS |
| 134 | |
| 135 | http://.../cgi-bin/mnav?a=<archive>&m=<period>&d=<direction>&t=<type> |
| 136 | |
| 137 | =head1 DESCRIPTION |
| 138 | |
| 139 | This CGI program is used for the next/prev period navigation for |
| 140 | an archive. |
| 141 | |
| 142 | The CGI program will send a client redirect URL to the period index |
| 143 | determined by specified input. |
| 144 | |
| 145 | =head1 CGI OPTIONS |
| 146 | |
| 147 | =over |
| 148 | |
| 149 | =item C<a> |
| 150 | |
| 151 | The name of the archive. Archive names are defined by C<lists.def>. |
| 152 | |
| 153 | =item C<d> |
| 154 | |
| 155 | The direction. Possible values are "C<prev>" or "C<next>". |
| 156 | |
| 157 | =item C<m> |
| 158 | |
| 159 | The period in YYYY-MM or YYYY format. |
| 160 | |
| 161 | =item C<t> |
| 162 | |
| 163 | The type of index to goto. For thread index, the value should be |
| 164 | set to "C<t>". If not set, or set to something else, date indexes |
| 165 | are used. |
| 166 | |
| 167 | =back |
| 168 | |
| 169 | =head1 VERSION |
| 170 | |
| 171 | C<$Id: mnav.cgi.in.dist,v 1.5 2002/10/17 03:11:31 ehood Exp $> |
| 172 | |
| 173 | =head1 AUTHOR |
| 174 | |
| 175 | Earl Hood, earl@earlhood.com |
| 176 | |
| 177 | This module is part of the mharc archiving system and comes with |
| 178 | ABSOLUTELY NO WARRANTY and may be copied only under the terms of |
| 179 | the GNU General Public License, which may be found in the MHArc |
| 180 | distribution. |
| 181 | |
| 182 | =cut |
| 183 | |