modules/Output.pm

   1 package Output;
   2
   3 #
   4 # Dev-Editor - Module Output
   5 #
   6 # HTML generating routines
   7 #
   8 # Author:        Patrick Canterino <patshaping@gmx.net>
   9 # Last modified: 2004-02-23
  10 #
  11
  12 use strict;
  13
  14 use vars qw(@EXPORT);
  15
  16 use CGI qw(header);
  17 use Tool;
  18
  19 use HTML::Entities;
  20 use Template;
  21
  22 ### Export ###
  23
  24 use base qw(Exporter);
  25
  26 @EXPORT = qw(error_template
  27              error
  28              abort
  29              error_in_use);
  30
  31 my $tpl_error;
  32
  33 # error_template()
  34 #
  35 # Set the path to the template file used for error messages
  36 # (I'm lazy...)
  37 #
  38 # Params: Template file
  39
  40 sub error_template($)
  41 {
  42  $tpl_error = shift;
  43 }
  44
  45 # error()
  46 #
  47 # Format an error message
  48 #
  49 # Params: 1. Error message
  50 #         2. Virtual path to which a link should be displayed (optional)
  51 #         3. Hash reference: Template variables (optional)
  52 #
  53 # Return: Formatted message (Scalar Reference)
  54
  55 sub error($;$$)
  56 {
  57  my ($message,$path,$vars) = @_;
  58
  59  my $tpl = new Template;
  60  $tpl->read_file($tpl_error);
  61
  62  $tpl->fillin("ERROR",$message);
  63  $tpl->fillin("DIR",$path);
  64  $tpl->fillin("SCRIPT",encode_entities($ENV{'SCRIPT_NAME'}));
  65
  66  $tpl->parse_if_block("dir",defined $path);
  67
  68  if(ref($vars) eq "HASH")
  69  {
  70   while(my ($key,$value) = each(%$vars))
  71   {
  72    $tpl->fillin($key,$value);
  73   }
  74  }
  75
  76  my $output = header(-type => "text/html");
  77  $output   .= $tpl->get_template;
  78
  79  return \$output;
  80 }
  81
  82 # abort()
  83 #
  84 # Print an error message and exit script
  85 # ^^^^^
  86 #
  87 # Params: 1. Error message
  88 #         2. Hash reference: Template variables (optional)
  89
  90 sub abort($;$)
  91 {
  92  my $output = error(shift,undef,shift);
  93  print $$output;
  94  exit;
  95 }
  96
  97 # error_in_use()
  98 #
  99 # Create a message, which shows, that a
 100 # file is currently in use
 101 #
 102 # Params: File, which is in use
 103 #
 104 # Return: Formatted message (Scalar Reference)
 105
 106 sub error_in_use($)
 107 {
 108  my $file = shift;
 109
 110  return error("The file '".encode_entities($file)."' is currently edited by someone else.",upper_path($file));
 111 }
 112
 113 # it's true, baby ;-)
 114
 115 1;
 116
 117 #
 118 ### End ###