File Coverage

blib/lib/Apache/TimedRedirect.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Apache::TimedRedirect;
2              
3 1     1   584 use strict;
  1         2  
  1         31  
4 1     1   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  1         2  
  1         89  
5              
6             require Exporter;
7              
8             @ISA = qw(Exporter AutoLoader);
9             @EXPORT = qw(
10             );
11             $VERSION = '0.13';
12              
13              
14             # Preloads.
15              
16 1     1   4394 use Time::Period;
  1         53  
  1         62  
17 1     1   1406 use Apache::Constants qw(OK DECLINED REDIRECT);
  0            
  0            
18             sub handler {
19             # the request object
20             my $r = shift;
21             # get the uri requested
22             my $uri = $r->uri;
23             # get the url to redirect too
24             my $rurl = $r->dir_config('redirecturl');
25             # get the time window in Time::Period format
26             # Note READ Time::Period carefully hr{4am-5am}
27             # is 4:00am - 5:59:59am
28             my $tw = $r->dir_config('timewindow');
29             my $uriregex = $r->dir_config('uriregex');
30             my $log = $r->dir_config('log') or 0;
31             # this allows weebbymaster to bypass redirect
32             my $xip = $r->dir_config('excludeip') or 'NONE';
33             # get the host ip and see if its 'special'
34             my $rh = $r->connection()->remote_ip();
35             # allow a host IP through
36             return DECLINED if $rh eq $xip;
37             # check if timewindow and URI request match
38             if (inPeriod(time(), $tw) == 1 && $uri =~ /$uriregex/) {
39             print STDERR "TimedRedirect: $rh requesting $uri matched $uriregex during time period: $tw redirected: $rurl\n" if $log;
40             $r->header_out(Location=>$rurl);
41             return REDIRECT;
42             } else {
43             return DECLINED;
44             }
45              
46             }
47              
48             # Autoload methods go after =cut, and are processed by the autosplit program.
49              
50             1;
51             __END__