Commit | Line | Data |
---|---|---|
01c223d0 BOFG |
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 '@@SW_ROOT@@/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 = '@@HTML_DIR@@'; | |
41 | ||
42 | ## URL pathname to where HTML archives are located. | |
43 | my $url_archive_root = '@@HTML_URL@@'; | |
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 |