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