site/cgi-bin/modules/DevHelp/HTML.pm

   1 package DevHelp::HTML;
   2 use strict;
   3 use Carp qw(confess);
   4
   5 require Exporter;
   6 use vars qw(@EXPORT_OK @EXPORT @ISA);
   7 @EXPORT_OK = qw(escape_html escape_uri unescape_html unescape_uri popup_menu);
   8 @EXPORT = qw(escape_html escape_uri unescape_html unescape_uri);
   9 @ISA = qw(Exporter);
  10
  11 use HTML::Entities ();
  12
  13 sub escape_html {
  14   HTML::Entities::encode(shift, '<>&"\x7F-\xFF');
  15 }
  16
  17 sub unescape_html {
  18   HTML::Entities::decode(shift);
  19 }
  20
  21 sub escape_uri {
  22   URI::Escape::uri_escape(shift);
  23 }
  24
  25 sub unescape_uri {
  26   URI::Escape::uri_unescape(shift);
  27 }
  28
  29 sub popup_menu {
  30   my (%opts) = @_;
  31
  32   exists $opts{'-name'}
  33     or confess "No -name parameter";
  34
  35   my $html = '<select name="' . escape_html($opts{"-name"}) . '">';
  36   my $labels = $opts{"-labels"} || {};
  37   my $values = $opts{"-values"};
  38   my $default = $opts{"-default"};
  39   for my $value (@$values) {
  40     my $option = "<option";
  41     my $label = $labels->{$value};
  42     if (defined $label) {
  43       $option .= ' value="' . escape_html($value) . '"';
  44       $option .= ' checked' if defined($default) && $default eq $value;
  45       $option .= '>' . escape_html($label);
  46     }
  47     else {
  48       $option .= ' checked' if defined($default) && $default eq $value;
  49       $option .= '>' . escape_html($value);
  50     }
  51     $html .= $option . "\n";
  52   }
  53   $html .= "</select>";
  54 }
  55
  56 1;