bind results from the CPAN

bind
Apache-MiniWiki
view release on metacpan or search on metacpan
#
# Copyright (C) 2002  Wim Kerkhoff <kerw@cpan.org>
# Copyright (C) 2001  Jonas Öberg <jonas@gnu.org>
#
# All rights reserved.
#
# You may distribute under the terms of either the GNU
# General Public License (see License.GPL) or the Artistic License
# (see License.Artistic).

package Apache::MiniWiki;

use 5.006;
use strict;

use Apache::Constants;
use Apache::Htpasswd;
use Carp;
use CGI qw(:cgi);
use Date::Manip;
use File::stat;
use HTML::Entities;
use HTML::FromText;
use HTML::LinkExtor;
use HTML::Template;
use Rcs 1.04;

our ($VERSION, $datadir, $vroot, $authen, $template, $timediff, @templates, $uploads, $precaching);

$VERSION = 0.92;

# Global variables:
# $datadir:       # Directory where we store Wiki pages (full path)
# $vroot:         # The virtual root we're using (eg /wiki)
# $authen:        # Set to filename when using basic authentification
# $template:      # HTML::Template object
# $timediff:      # delta from GMT, eg:  -8 for PST, +4.5 for IST
# @templates:     # list of templates to use for other entry pages

# Global variables containing the recognized file extensions
# for images and binary files.
our @imgfmts = qw ( jpg jpeg gif png );
our @binfmts = ( @imgfmts, qw ( pdf doc ps gz zip bz2 tar ) );

# global variables to set thumbnail cutoff
our ($max_width, $max_height) = (600,400);

# This sets the directory where Rcs can find the rcs binaries.
# Set this to something more sensible if they are located elsewhere.
Rcs->bindir('/usr/bin');


# The function fatal_error is called most commonly when the Apache virtual
# host has not had the correlt PerlVar's configured.
sub fatal_error {
  my ($r, $text) = @_;

  my $uri = $r->uri;

  $r->log_error($text);

  print <<__EOT__;
<html>
 <body>
  <p id="title">Error in Apache::MiniWiki</p>
  <hr/>
  $text
  <hr/>
  While viewing: $uri
  <hr/>
  This should never have occurred. Please notify the administrator responsible for this site.
 </body>
</html>
__EOT__
  return OK;
}

## The function pretty_error is called most commonly when the the user
## has done something correctly, and needs to be informed. In this situation,
## we assume that things like a template and so forth are available.
sub pretty_error {
  my ($r, $text, $return) = @_;

  $return ||= OK;

  my $uri = $r->uri;

  my $newtext = <<TEXT;
Error

*NOTE:* $text

Please hit the *back* button in your browser, and try again.
TEXT
  $newtext = &prettify($newtext);
    
  $template->param('vroot', $vroot || "no vroot");
  $template->param('title', $uri);
  $template->param('body', $newtext);
  $template->param('editlink', "$vroot/\(edit\)\/$uri");
  $template->param('loglink', "$vroot/\(log\)\/$uri");
  $template->param('pageurl', "http://$ENV{SERVER_NAME}:$ENV{SERVER_PORT}$ENV{REQUEST_URI}");
  
  my $output = $template->output;
  
  $r->send_http_header('text/html');
  print $output;

  return $return;
}
( run in 4.464 seconds using v1.01-cache-2.11-cpan-2398b32b56e )