modules/Output.pm

   1
   2 package Output;
   3
   4 #
   5 # Dev-Editor - Module Output
   6 #
   7 # HTML generating routines
   8 #
   9 # Author:        Patrick Canterino <patrick@patshaping.de>
  10 # Last modified: 2005-05-10
  11 #
  12 # Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann
  13 # Copyright (C) 2003-2009 Patrick Canterino
  14 # All Rights Reserved.
  15 #
  16 # This file can be distributed and/or modified under the terms of
  17 # of the Artistic License 1.0 (see also the LICENSE file found at
  18 # the top level of the Dev-Editor distribution).
  19 #
  20
  21 use strict;
  22
  23 use vars qw(@EXPORT);
  24
  25 use CGI qw(header
  26            escape);
  27
  28 use Template;
  29 use Tool;
  30
  31 ### Export ###
  32
  33 use base qw(Exporter);
  34
  35 @EXPORT = qw(error_template
  36              error
  37              abort);
  38
  39 my $tpl_error;
  40
  41 # error_template()
  42 #
  43 # Set the path to the template file used for error messages
  44 # (I'm lazy...)
  45 #
  46 # Params: Template file
  47
  48 sub error_template($)
  49 {
  50  $tpl_error = shift;
  51 }
  52
  53 # error()
  54 #
  55 # Format an error message
  56 #
  57 # Params: 1. Error message
  58 #         2. Display a link to this path at the bottom of the page (optional)
  59 #            Please use the unencoded form of the string!
  60 #         3. Hash reference: Template variables (optional)
  61 #
  62 # Return: Formatted message (Scalar Reference)
  63
  64 sub error($;$$)
  65 {
  66  my ($message,$path,$vars) = @_;
  67
  68  my $tpl = new Template;
  69  $tpl->read_file($tpl_error);
  70
  71  $tpl->fillin('ERROR',$message);
  72
  73  $tpl->set_var('BACK',encode_html($path));
  74  $tpl->set_var('BACK_URL',escape($path));
  75  $tpl->set_var('SCRIPT',encode_html($ENV{'SCRIPT_NAME'}));
  76
  77  $tpl->parse_if_block('dir',defined $path);
  78
  79  if(ref($vars) eq 'HASH')
  80  {
  81   while(my ($key,$value) = each(%$vars))
  82   {
  83    $tpl->set_var($key,$value);
  84   }
  85  }
  86
  87  $tpl->parse;
  88
  89  my $output = header(-type => 'text/html');
  90  $output   .= $tpl->get_template;
  91
  92  return \$output;
  93 }
  94
  95 # abort()
  96 #
  97 # Print an error message and exit script
  98 # ^^^^^
  99 #
 100 # Params: 1. Error message
 101 #         2. Display a link to this path at the bottom of the page (optional)
 102 #         3. Hash reference: Template variables (optional)
 103
 104 sub abort($;$$)
 105 {
 106  my $output = error(shift,shift,shift);
 107  print $$output;
 108  exit;
 109 }
 110
 111 # it's true, baby ;-)
 112
 113 1;
 114
 115 #
 116 ### End ###