modules/Output.pm

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