X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=blobdiff_plain;f=Status.pm;fp=Status.pm;h=116c81d93ed6240e25329eb3832e22ebe3789965;hp=0000000000000000000000000000000000000000;hb=adf50ea526c9de029a489de03ab45e35c215f64f;hpb=7072798887564c7e94795b7e5ccd786ff2739e35 diff --git a/Status.pm b/Status.pm new file mode 100644 index 0000000..116c81d --- /dev/null +++ b/Status.pm @@ -0,0 +1,50 @@ +# $Id$ +# Perl template for custom status reporter (for 'favicon.ico'). +# Copyright (C) 2003-2005 Jan Kratochvil +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; exactly version 2 of June 1991 is required +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +package My::Status; +require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway +our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; +our $CVS_ID=q$Id$; +use strict; +use warnings; + +use My::Web; +use Apache2::Const qw(HTTP_NOT_FOUND); + + +our $HTML_TEST="download"; +our $HTML_TEST_RC=HTTP_NOT_FOUND; +our $HTML_TEST_QUERY_STRING="code=404"; + +sub handler +{ +my $W=My::Web->init( + "args_check"=>{ + "code"=>'^\d+$', + }, + ); + + $W->{"r"}->status($W->{"args"}{"code"}); + $W->{"header_only"}=1; + $W->{"content_type"}=0; + $W->{"charset"}=0; + My::Web->heading(); + exit; + die "NOTREACHED"; +} +1;