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: 09-23-2003
  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 and 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">
  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: Error message
  83 #
  84 # Return: Formatted message (Scalar Reference)
  85
  86 sub error($)
  87 {
  88  my $message = shift;
  89
  90  my $output = htmlhead("Error");
  91  $output   .= "<p>$message</p>";
  92  $output   .= htmlfoot;
  93
  94  return \$output;
  95 }
  96
  97 # abort()
  98 #
  99 # Print an error message and exit script
 100 # ^^^^^
 101 #
 102 # Params: Error message
 103
 104 sub abort($)
 105 {
 106  my $output = error(shift);
 107  print $$output;
 108  exit;
 109 }
 110
 111 # error_in_use()
 112 #
 113 # Create a message, that a file is currently in use
 114 #
 115 # Params: File, which is in use
 116 #
 117 # Return: Formatted message (Scalar Reference)
 118
 119 sub error_in_use($)
 120 {
 121  my $file = encode_entities(shift);
 122  my $dir  = upper_path($file);
 123
 124  my $message = htmlhead("File in use");
 125  $message   .= "<p>The file '$file' is currently editet by someone else.</p>\n\n";
 126  $message   .= "<a href=\"$ENV{'SCRIPT_NAME'}?command=show&file=$dir\"><p>Back to $dir</a></p>";
 127  $message   .= htmlfoot;
 128
 129  return \$message;
 130 }
 131
 132 # equal_url()
 133 #
 134 # Create an "equals"-link and print it out
 135 #
 136 # Params: 1. HTTP root
 137 #         2. Relative path
 138 #
 139 # Return: Formatted link (String)
 140
 141 sub equal_url($$)
 142 {
 143  my ($root,$path) = @_;
 144  my $url;
 145
 146  $root =~ s!/$!!;
 147  $path =~ s!^/!!;
 148  $url  =  $root."/".$path;
 149  $url  =  encode_entities($url);
 150
 151  return "<p>(equals <a href=\"$url\" target=\"_blank\">$url</a>)</p>\n\n";
 152 }
 153
 154 # dir_link()
 155 #
 156 # Create the link to the directory of a file and
 157 # print it out
 158 #
 159 # Params: File
 160 #
 161 # Return: Formatted link (String)
 162
 163 sub dir_link($)
 164 {
 165  my $dir = upper_path(shift);
 166  $dir    = encode_entities($dir);
 167
 168  return "<p><a href=\"$ENV{'SCRIPT_NAME'}?command=show&file=$dir\">Back to $dir</a></p>\n\n";
 169 }
 170
 171 # it's true, baby ;-)
 172
 173 1;
 174
 175 #
 176 ### End ###