lib/Packages/CGI.pm

   1 package Packages::CGI;
   2
   3 use Exporter;
   4 our @ISA = qw( Exporter );
   5 our @EXPORT = qw( fatal_error error hint debug msg
   6                   print_errors print_hints print_debug print_msgs );
   7
   8 our $debug = 0;
   9
  10 our (@fatal_errors, @errors, @debug, @msgs, @hints);
  11
  12 sub reset {
  13     @fatal_errors = @errors = @debug = @msgs = @hints = ();
  14 }
  15
  16 sub fatal_error {
  17     push @fatal_errors, $_[0];
  18 }
  19 sub error {
  20     push @errors, $_[0];
  21 }
  22 sub hint {
  23     push @hints, $_[0];
  24 }
  25 sub debug {
  26     my $lvl = $_[1] || 0;
  27     push(@debug, $_[0]) if $debug > $lvl;
  28 }
  29 sub msg {
  30     push @msgs, $_[0];
  31 }
  32 sub print_errors {
  33     return unless @fatal_errors || @errors;
  34     print '<div style="background-color:#F99;font-weight:bold;padding:0.5em;margin:0;">';
  35     foreach ((@fatal_errors, @errors)) {
  36         print "<p>ERROR: $_</p>";
  37     }
  38     print '</div>';
  39 }
  40 sub print_debug {
  41     return unless $debug && @debug;
  42     print '<div style="font-size:80%;border:solid thin grey">';
  43     print '<h2>Debugging:</h2><pre>';
  44     foreach (@debug) {
  45         print "$_\n";
  46     }
  47     print '</pre></div>';
  48
  49 }
  50 sub print_hints {
  51     return unless @hints;
  52     print '<div>';
  53     foreach (@hints) {
  54         print "<p style=\"background-color:#FF9;padding:0.5em;margin:0\">$_</p>";
  55     }
  56     print '</div>';
  57 }
  58 sub print_msgs {
  59     foreach (@msgs) {
  60         print "<p>$_</p>";
  61     }
  62 }
  63
  64 1;