some attempt at encoding by name.

diff --git a/botm_common.pm b/botm_common.pm
index e5c5f014dc9e0c945d5f3f998dde0bcc9169039e..48d1b48f09c38228b093ceef7c4dccec5618a441 100644 (file)
--- a/botm_common.pm
+++ b/botm_common.pm
@@ -25,14 +25,14 @@ use Exporter;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 # vX.Y.Z:      X YYYZZZ
-$VERSION     = 1.000005;
+$VERSION     = 1.000006;
 @ISA         = qw(Exporter);
 @EXPORT      = ();
 @EXPORT_OK   = (
        'read_data_file', 'write_data_file',
        'url_encode', 'url_decode',
        'join_path',
-       'html_entity_encode_dec', 'html_entity_encode_hex'
+       'html_entity_encode_dec', 'html_entity_encode_hex', 'html_entity_encode_name'
 );
 %EXPORT_TAGS = ();
 
@@ -2587,60 +2587,89 @@ use constant HTML_ENTITY_CODE_INF => {
 
 
 sub html_entity_encode_dec {
-       # (my $t, my $encoding, my $all) = @_;
        (my $t, my $all) = @_;
        
        if ($all) {
-               # $t =~ s/(.)/html_entity_encode_1ch_dec($1, $encoding)/eg;
                $t =~ s/(.)/html_entity_encode_1ch_dec($1)/eg;
        }
        else {
-               # $t =~ s/([\"\&<=>])/html_entity_encode_1ch_dec($1, $encoding)/eg;
                $t =~ s/([\"\&<=>])/html_entity_encode_1ch_dec($1)/eg;
        }
        return $t;
 }
 
 sub html_entity_encode_hex {
-       # (my $t, my $encoding, my $all) = @_;
        (my $t, my $all) = @_;
        
        if ($all) {
-               # $t =~ s/(.)/html_entity_encode_1ch_hex($1, $encoding)/eg;
                $t =~ s/(.)/html_entity_encode_1ch_hex($1)/eg;
        }
        else {
-               # $t =~ s/([\"\&<=>])/html_entity_encode_1ch_hex($1, $encoding)/eg;
                $t =~ s/([\"\&<=>])/html_entity_encode_1ch_hex($1)/eg;
        }
        return $t;
 }
 
+sub html_entity_encode_name {
+       (my $t, my $all) = @_;
+       
+       if ($all) {
+               $t =~ s/(.)/html_entity_encode_1ch_name($1,1)/eg;
+       }
+       else {
+               $t =~ s/([\"\&<=>])/html_entity_encode_1ch_name($1,0)/eg;
+       }
+}
+
 sub html_entity_encode_1ch_dec {
-       # (my $ch, my $encoding) = @_;
        (my $ch) = @_;
        
-       # if ($encoding ne '') {
-               # # escape byte values instead of code point value
-               # $ch = encode($encoding, $ch);
-       # }
        $ch =~ s/(.)/sprintf('&#%02u;',ord($1))/eg;
        return $ch;
 }
 
 sub html_entity_encode_1ch_hex {
-       # (my $ch, my $encoding) = @_;
        (my $ch) = @_;
        
-       # if ($encoding ne '') {
-               # # escape byte values instead of code point value
-               # $ch = encode($encoding, $ch);
-       # }
        $ch =~ s/(.)/sprintf('&#x%02X;',ord($1))/eg;
        return $ch;
 }
 
-# TODO:
+sub html_entity_encode_1ch_name {
+       (my $ch, my $all) = @_;
+       
+       unless ($all) {
+               if ($ch eq '"') {
+                       return '&quot;';
+               }
+               elsif ($ch eq '&') {
+                       return '&amp;';
+               }
+               elsif ($ch eq '<') {
+                       return '&lt;'
+               }
+               elsif ($ch eq '=') {
+                       return '&equals';
+               }
+               elsif ($ch eq '>') {
+                       return '&gt';
+               }
+               else {
+                       return $ch;
+               }
+       }
+       else {
+               my $n = ord($ch);
+               foreach my $name (keys HTML_ENTITY_CODE) {
+                       if (HTML_ENTITY_CODE->{$name} == [$n]) {
+                               return "&$name;";
+                       }
+               }
+               return $ch;
+       }
+}
+
+
 # html_entity_encode_name
 # html_entity_decode