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: 2003-12-13
  10 #
  11
  12 use strict;
  13
  14 use vars qw(@EXPORT);
  15
  16 use CGI qw(header);
  17 use HTML::Entities;
  18 use Tool;
  19
  20 ### Export ###
  21
  22 use base qw(Exporter);
  23
  24 @EXPORT = qw(htmlhead
  25              htmlfoot
  26              error
  27              abort
  28              error_in_use
  29              equal_url
  30              dir_link);
  31
  32 # htmlhead()
  33 #
  34 # Generate the head of a HTML document
  35 # (a text/html HTTP header will also be created)
  36 #
  37 # Params: Title/heading
  38 #
  39 # Return: Head for the HTML document
  40
  41 sub htmlhead($)
  42 {
  43  my $title = shift;
  44
  45  my $html = header(-type => "text/html");
  46
  47  $html .= <<END;
  48 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
  49 "http://www.w3.org/TR/html4/loose.dtd">
  50
  51 <html>
  52 <head>
  53 <title>$title</title>
  54 <meta http-equiv="content-type" content="text/html; charset=iso-8859-1">
  55 </head>
  56 <body bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#800080" alink="#FF0000">
  57
  58 <h1>$title</h1>
  59
  60 END
  61
  62  return $html;
  63 }
  64
  65 # htmlfoot()
  66 #
  67 # Generate the foot of a HTML document
  68 #
  69 # Params: -nothing-
  70 #
  71 # Return: Foot for the HTML document
  72
  73 sub htmlfoot
  74 {
  75  return "\n</body>\n</html>";
  76 }
  77
  78 # error()
  79 #
  80 # Format an error message
  81 #
  82 # Params: 1. Error message
  83 #         2. Virtual path to which a link should be displayed (optional)
  84 #
  85 # Return: Formatted message (Scalar Reference)
  86
  87 sub error($;$)
  88 {
  89  my ($message,$path) = @_;
  90
  91  my $output = htmlhead("Error");
  92  $output   .= "<p>$message</p>";
  93
  94  if($path)
  95  {
  96   $path = encode_entities($path);
  97
  98   $output .= "\n\n";
  99   $output .= "<p><a href=\"$ENV{'SCRIPT_NAME'}?command=show&file=$path\">Back to $path</a></p>";
 100  }
 101
 102  $output .= htmlfoot;
 103
 104  return \$output;
 105 }
 106
 107 # abort()
 108 #
 109 # Print an error message and exit script
 110 # ^^^^^
 111 #
 112 # Params: Error message
 113
 114 sub abort($)
 115 {
 116  my $output = error(shift);
 117  print $$output;
 118  exit;
 119 }
 120
 121 # error_in_use()
 122 #
 123 # Create a message, which shows, that a
 124 # file is currently in use
 125 #
 126 # Params: File, which is in use
 127 #
 128 # Return: Formatted message (Scalar Reference)
 129
 130 sub error_in_use($)
 131 {
 132  my $file = shift;
 133
 134  return error("The file '".encode_entities($file)."' is currently edited by someone else.",upper_path($file));
 135 }
 136
 137 # equal_url()
 138 #
 139 # Create an "equals"-link
 140 #
 141 # Params: 1. HTTP root
 142 #         2. Relative path
 143 #
 144 # Return: Formatted link (String)
 145
 146 sub equal_url($$)
 147 {
 148  my ($root,$path) = @_;
 149  my $url;
 150
 151  $root =~ s!/$!!;
 152  $path =~ s!^/!!;
 153  $url  =  $root."/".$path;
 154  $url  =  encode_entities($url);
 155
 156  return "<p>(equals <a href=\"$url\" target=\"_blank\">$url</a>)</p>\n\n";
 157 }
 158
 159 # dir_link()
 160 #
 161 # Create the link to the directory of a file
 162 #
 163 # Params: File
 164 #
 165 # Return: Formatted link (String)
 166
 167 sub dir_link($)
 168 {
 169  my $dir = upper_path(shift);
 170  $dir    = encode_entities($dir);
 171
 172  return "<p><a href=\"$ENV{'SCRIPT_NAME'}?command=show&file=$dir\">Back to $dir</a></p>\n\n";
 173 }
 174
 175 # it's true, baby ;-)
 176
 177 1;
 178
 179 #
 180 ### End ###