home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / ASCIInames.pm < prev    next >
Encoding:
Perl POD Document  |  2004-02-18  |  15.7 KB  |  506 lines
  1. package Convert::ASCIInames;
  2. #
  3. # $Id: ASCIInames.pm,v 1.2 2004/02/18 13:58:58 coar Exp $
  4. #
  5. #   CPAN module Convert::ASCIInames
  6. #
  7. #   Copyright 2004 Ken A L Coar
  8. #
  9. #   Licensed under the Apache License, Version 2.0 (the "License");
  10. #   you may not use this package or any files in it except in
  11. #   compliance with the License.  A copy of the License should be
  12. #   included as part of the package; the normative version may be
  13. #   obtained a copy of the License at
  14. #
  15. #       http://www.apache.org/licenses/LICENSE-2.0
  16. #
  17. #   Unless required by applicable law or agreed to in writing, software
  18. #   distributed under the License is distributed on an "AS IS" BASIS,
  19. #   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  20. #   See the License for the specific language governing permissions and
  21. #   limitations under the License.
  22. #
  23.  
  24. use strict;
  25. use Carp;
  26.  
  27. #
  28. BEGIN {
  29.     use Exporter ();
  30.     use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31.     use vars qw (%ord2name %ord2alt %name2ord %alt2ord $config);
  32.     $VERSION     = sprintf('%d.%03d', q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
  33.     @ISA         = qw (Exporter);
  34.     #
  35.     # Give a hoot and don't pollute, do not export more than needed by default
  36.     #
  37.     @EXPORT      = qw (ASCIIname
  38.                        ASCIIaltname
  39.                        ASCIIordinal
  40.                        ASCIIdescription
  41.                        ASCIIaltdescription
  42.                       );
  43.     @EXPORT_OK   = qw ();
  44.     %EXPORT_TAGS = ();
  45.  
  46.     #
  47.     # Set up our constants and configuration; since this isn't an
  48.     # object-oriented module, these values apply throughout.
  49.     #
  50.     $config->{fallthrough} = 1;
  51.     $config->{strict_ordinals} = 0;
  52.     %ord2alt  = (
  53.                  0x09 => [ 'TAB', 'Horizontal tab' ],
  54.                  0x11 => [ 'XON', 'Flow control on' ],
  55.                  0x13 => [ 'XOFF', 'Flow control off' ],
  56.                  0x20 => [ 'SP', 'Space' ],
  57.                 );
  58.     %ord2name = (
  59.                  0x00 => [ 'NUL', 'Null character' ],
  60.                  0x01 => [ 'SOH', 'Start of Header' ],
  61.                  0x02 => [ 'STX', 'Start of Text' ],
  62.                  0x03 => [ 'ETX', 'End Of Text' ],
  63.                  0x04 => [ 'EOT', 'End Of Transmission' ],
  64.                  0x05 => [ 'ENQ', 'Enquiry' ],
  65.                  0x06 => [ 'ACK', 'Acknowledge' ],
  66.                  0x07 => [ 'BEL', 'Bell' ],
  67.                  0x08 => [ 'BS', 'Backspace' ],
  68.                  0x09 => [ 'HT', 'Horizontal Tab' ],
  69.                  0x0a => [ 'LF', 'Linefeed' ],
  70.                  0x0b => [ 'VT', 'Vertical Tab' ],
  71.                  0x0c => [ 'FF', 'Formfeed' ],
  72.                  0x0d => [ 'CR', 'Carriage Return' ],
  73.                  0x0e => [ 'SO', 'Shift Out' ],
  74.                  0x0f => [ 'SI', 'Shift In' ],
  75.                  0x10 => [ 'DLE', 'Data Link Escape' ],
  76.                  0x11 => [ 'DC1', 'Device Control 1' ],
  77.                  0x12 => [ 'DC2', 'Device Control 2' ],
  78.                  0x13 => [ 'DC3', 'Device Control 3' ],
  79.                  0x14 => [ 'DC4', 'Device Control 4' ],
  80.                  0x15 => [ 'NAK', 'Negative Acknowledge' ],
  81.                  0x16 => [ 'SYN', 'Synchronous Idle' ],
  82.                  0x17 => [ 'ETB', 'End of Transmission Block' ],
  83.                  0x18 => [ 'CAN', 'Cancel' ],
  84.                  0x19 => [ 'EM', 'End of Medium' ],
  85.                  0x1a => [ 'SUB', 'Substitute' ],
  86.                  0x1b => [ 'ESC', 'Escape' ],
  87.                  0x1c => [ 'FS', 'File Separator' ],
  88.                  0x1d => [ 'GS', 'Group Separator' ],
  89.                  0x1e => [ 'RS', 'Record Separator' ],
  90.                  0x1f => [ 'US', 'Unit Separator' ],
  91.                  0x7f => [ 'DEL', 'Delete' ],
  92.                  0x80 => [ 'RES1', 'Reserved for future standardizaton' ],
  93.                  0x81 => [ 'RES2', 'Reserved for future standardizaton' ],
  94.                  0x82 => [ 'RES3', 'Reserved for future standardizaton' ],
  95.                  0x83 => [ 'RES4', 'Reserved for future standardizaton' ],
  96.                  0x84 => [ 'IND', 'Index' ],
  97.                  0x85 => [ 'NEL', 'Next Line' ],
  98.                  0x86 => [ 'SSA', 'Start of Selected Area' ],
  99.                  0x87 => [ 'ESA', 'End of Selected Area' ],
  100.                  0x88 => [ 'HTS', 'Horizontal Tabulation Set' ],
  101.                  0x89 => [ 'HTJ', 'Horizontal Tab with Justify' ],
  102.                  0x8a => [ 'VTS', 'Vertical Tabulation Set' ],
  103.                  0x8b => [ 'PLD', 'Partial Line Down' ],
  104.                  0x8c => [ 'PLU', 'Partial Line Up' ],
  105.                  0x8d => [ 'RI', 'Reverse Index' ],
  106.                  0x8e => [ 'SS2', 'Single Shift 2' ],
  107.                  0x8f => [ 'SS3', 'Single Shift 3' ],
  108.                  0x90 => [ 'DCS', 'Device control string' ],
  109.                  0x91 => [ 'PU1', 'Private Use 1' ],
  110.                  0x92 => [ 'PU2', 'Private Use 2' ],
  111.                  0x93 => [ 'STS', 'Set Transmission State' ],
  112.                  0x94 => [ 'CCH', 'Cancel Character' ],
  113.                  0x95 => [ 'MW', 'Message Waiting' ],
  114.                  0x96 => [ 'SPA', 'Start of Protected Area' ],
  115.                  0x97 => [ 'EPA', 'End of Protected Area' ],
  116.                  0x98 => [ 'RES5', 'Reserved for future standardization' ],
  117.                  0x99 => [ 'RES6', 'Reserved for future standardization' ],
  118.                  0x9a => [ 'RES7', 'Reserved for future standardization' ],
  119.                  0x9b => [ 'CSI', 'Control Sequence Introducer' ],
  120.                  0x9c => [ 'ST', 'String Terminator' ],
  121.                  0x9d => [ 'OSC', 'Operating System Command' ],
  122.                  0x9e => [ 'PM', 'Privacy Message' ],
  123.                  0x9f => [ 'APC', 'Application Program Command' ],
  124.                 );
  125.     %alt2ord = ();
  126.     %name2ord = ();
  127.  
  128.     #
  129.     # Now for the backward conversions
  130.     #
  131.     while (my ($ord, $name) = each(%ord2name)) {
  132.         $name2ord{$name->[0]} = $ord;
  133.     }
  134.     while (my ($ord, $name) = each(%ord2alt)) {
  135.         $alt2ord{$name->[0]} = $ord;
  136.     }
  137. }
  138.  
  139. =pod
  140.  
  141. =head1 NAME
  142.  
  143. Convert::ASCIInames - ASCII names for control characters
  144.  
  145. =head1 SYNOPSIS
  146.  
  147.  use Convert::ASCIInames;
  148.  
  149.  Convert::ASCIInames::Configure(fallthrough => 1);
  150.  $name = ASCIIname($character_ordinal);
  151.  $name = ASCIIaltname($character_ordinal);
  152.  $name = ASCIIdescription($character_ordinal);
  153.  $name = ASCIIaltdescription($character_ordinal);
  154.  $character_ordinal = ASCIIordinal($name);
  155.  
  156. =head1 DESCRIPTION
  157.  
  158. Most if not all of the non-printing characters of the ASCII character set
  159. had special significance in the days of teletypes and paper tapes.
  160. For example, the character code 0x00 would be sent repeatedly in order
  161. to give the receiving end a chance to catch up; it signified "no action"
  162. and so was named C<NUL>.  The sending end might follow each line of text
  163. with a number of C<NUL> bytes in order to give the receiving end
  164. a chance to return its print carriage to the left margin.  The control
  165. characters (so-called because they were used to control aspects of
  166. communication or receiving devices) were given short 2-to-4 letter
  167. names, like C<CR>, C<EOT>, C<ACK>, and C<NAK>.
  168.  
  169. Some of these special purposes have become obsolete, but some of them
  170. are still in use.  For example, character 0x07 (C<BEL>) is used to
  171. ring the feeper; 0x05 (C<ENQ>) is recognised by many terminals as
  172. a trigger to report their status; and 0x08 (C<BS>) still means
  173. "move the cursor back one space".
  174.  
  175. This module will return the ASCII name for specified characters,
  176. or the character code if given an ASCII name.  In addition, the
  177. full descriptive name ("Start of Heading" instead of C<SOH>) is
  178. available, although reverse translation of the descriptions isn't
  179. provided.
  180.  
  181. Some control characters have altername names.  Character 0x13
  182. is named C<DC3> ("Device Control 3"), but is probably better
  183. known by its alternate name of C<XOFF>.  These alternate names
  184. are also available through this module's functions.
  185.  
  186. =head1 USAGE
  187.  
  188. Each of the functions in this module is described below.  They
  189. are listed in lexical order, rather than functional.
  190.  
  191. If you request the name (or alternate name) of a character that
  192. doesn't have one, you'll either get the actual character itself,
  193. or the name (if it has one) from the other list.  For instance,
  194. if you request the alternate name for 0x00, which doesn't have
  195. one, the return value will either be C<NUL> (the primary name)
  196. or the value of C<chr(0x00)>.  The former is called "falling
  197. through," and is controlled by the setting of the C<fallthrough>
  198. configuration option.  If the option is set to a true value,
  199. the module will attempt to give you the best name it can; if
  200. it's set to a false value, you'll either get exactly what you
  201. requested (such as the alternate name) or the character itself.
  202.  
  203. If you provide an invalid character ordinal (such as a non-integer,
  204. or one outside the range of 0-255), Convert::ASCIInames will
  205. throw a message using C<carp()> and use a standard substitute
  206. value instead:
  207.  
  208. =over 4
  209.  
  210. =item o B<Ordinal is omitted or is a zero-length string>
  211.  
  212. The value 0x00 will be used.
  213.  
  214. =item o B<Ordinal E<lt> 0 or E<gt> 255>
  215.  
  216. The value 255 (0xff) will be used instead.
  217.  
  218. =item o B<Ordinal is a non-integer>
  219.  
  220. The ordinal of the first character of the argument will be used.
  221. If option C<strict_ordinals> is set, a warning message will be
  222. issued.
  223.  
  224. =back
  225.  
  226. =cut
  227.  
  228. =pod
  229.  
  230. =head2 ASCIIaltdescription
  231.  
  232.  $text = ASCIIaltdescription($ordinal);
  233.  
  234. This function returns the description for the alternate name, if any,
  235. for the character with the specified ordinal.  If there is no
  236. altername name, the description of the primary name (if any) will be
  237. returned if the C<fallthrough> option is set; otherwise the value of
  238. C<chr($ordinal)> will be returned.
  239.  
  240. =cut
  241.  
  242. sub ASCIIaltdescription {
  243.     my ($ord) = is_ord(@_);
  244.     my $char;
  245.  
  246.     $char = ($ord2alt{$ord}->[1]
  247.              || ($config->{fallthrough} ? $ord2name{$ord}->[1] : 0)
  248.              || chr($ord));
  249.     return $char;
  250. }
  251.  
  252. =pod
  253.  
  254. =head2 ASCIIaltname
  255.  
  256.  $text = ASCIIaltname($ordinal);
  257.  
  258. This function returns the alternate name, if any, for the
  259. character with the specified ordinal.  If there is no altername
  260. name, the primary name (if any) will be returned if the C<fallthrough>
  261. option is set; otherwise the value of C<chr($ordinal)> will be
  262. returned.
  263.  
  264. =cut
  265.  
  266. sub ASCIIaltname {
  267.     my ($ord) = is_ord(@_);
  268.     my $char;
  269.  
  270.     $char = ($ord2alt{$ord}->[0]
  271.              || ($config->{fallthrough} ? $ord2name{$ord}->[0] : 0)
  272.              || chr($ord));
  273.     return $char;
  274. }
  275.  
  276. =pod
  277.  
  278. =head2 ASCIIdescription
  279.  
  280.  $text = ASCIIdescription($ordinal);
  281.  
  282. This function returns the description for the primary name, if any,
  283. for the character with the specified ordinal.  If there is no
  284. primary name, the description of the alternate name (if any) will be
  285. returned if the C<fallthrough> option is set; otherwise the value of
  286. C<chr($ordinal)> will be returned.
  287.  
  288. Note that it is unlikely that a character will have an alternate
  289. name but not a primary one.
  290.  
  291. =cut
  292.  
  293. sub ASCIIdescription {
  294.     my ($ord) = is_ord(@_);
  295.     my $char;
  296.  
  297.     $char = ($ord2name{$ord}->[1]
  298.              || ($config->{fallthrough} ? $ord2alt{$ord}->[1] : 0)
  299.              || chr($ord));
  300.     return $char;
  301. }
  302.  
  303. =pod
  304.  
  305. =head2 ASCIIname
  306.  
  307. This function returns the primary name, if any, for the
  308. character with the specified ordinal.  If there is no primary
  309. name, the alternate name (if any) will be returned if the C<fallthrough>
  310. option is set; otherwise the value of C<chr($ordinal)> will be
  311. returned.
  312.  
  313. Note that it is unlikely that a character will have an alternate
  314. name but not a primary one.
  315.  
  316. =cut
  317.  
  318. sub ASCIIname {
  319.     my ($ord) = is_ord(@_);
  320.     my $char;
  321.  
  322.     $char = ($ord2name{$ord}->[0]
  323.              || ($config->{fallthrough} ? $ord2alt{$ord}->[0] : 0)
  324.              || chr($ord));
  325.     return $char;
  326. }
  327.  
  328. =pod
  329.  
  330. =head2 ASCIIordinal
  331.  
  332.  $ordinal = ASCIIordinal($name)
  333.  
  334. This function will attempt to look up the specified name in
  335. the primary and alternate lists, and return the ordinal of
  336. any match it finds.  For example:
  337.  
  338.   my $ord = ASCIIordinal('xoff');
  339.   printf("xoff = 0x%02x\n", $ord);
  340.  
  341. would print
  342.  
  343.   xoff = 0x13
  344.  
  345. If the name does not appear in the primary or alternate list, the
  346. ordinal of the first character of the string will be returned.
  347.  
  348. The argument is not case-sensitive.
  349.  
  350. =cut
  351.  
  352. sub ASCIIordinal {
  353.     my ($name) = is_char(@_);
  354.     my $char;
  355.  
  356.     $char = ($name2ord{uc($name)}
  357.              || ($config->{fallthrough} ? $alt2ord{uc($name)} : 0)
  358.              || ord(substr($name, 0, 1)));
  359.     return $char;
  360. }
  361.  
  362. =pod
  363.  
  364. =head2 Convert::ASCIInames::Configure
  365.  
  366.  Convert::ASCIInames::Configure(..options..)
  367.  
  368. This function sets the options controlling some details of
  369. Convert::ASCIInames' operation.  Options are specifed as either
  370. a hash or a hashref:
  371.  
  372.  Convert::ASCIInames::Configure(fallback => 1);
  373.  
  374.  my $opts = { fallback => 1, strict_ordinals => 0};
  375.  Convert::ASCIInames::Configure($opts);
  376.  
  377. The possible options are:
  378.  
  379. =over 4
  380.  
  381. =item o C<fallthrough>
  382.  
  383. If this option is set to a true value, Convert::ASCIInames will search
  384. both the primary and the alternate (or I<vice versa>) lists for
  385. the specified character or name.  If set to a false value, only the
  386. list you indicate will be searched.
  387.  
  388. Default is true.
  389.  
  390. =item o C<strict_ordinals>
  391.  
  392. When a function that takes a character ordinal is passed an argument
  393. that is nominally invalid (I<i.e.>, not a positive integer between 0
  394. and 255 inclusive), it will use the C<ord()> value of the first byte
  395. of the argument.  If the C<strict_ordinals> option is set to true,
  396. a warning message will be generated, just in case this isn't
  397. what you intended.  If set to false, there is no message.
  398.  
  399. The default value is false.
  400.  
  401. =back
  402.  
  403. =cut
  404.  
  405. sub Configure {
  406.     my (@opts) = @_;
  407.     my $prehash;
  408.     my (%ohash) = ((ref($opts[0]) eq 'HASH') ? %{$opts[0]} : @opts);
  409.  
  410.     for (keys(%{$config})) {
  411.         $prehash->{$_} = $config->{$_};
  412.         if (defined($ohash{$_})) {
  413.             $config->{$_} = $ohash{$_};
  414.         }
  415.     }
  416.     return $prehash;
  417. }
  418.  
  419. #
  420. # Check that a value is really a valid character (or string).
  421. #
  422. sub is_char {
  423.     my ($val, $truncate) = @_;
  424.  
  425.     if ((! defined($val)) || (length($val) == 0)) {
  426.         carp('Null character; using NUL');
  427.         return chr(0x00);
  428.     }
  429.     return ($truncate ? substr($val, 0, 1) : $val);
  430. }
  431.  
  432. #
  433. # Check that a value is really a valid ordinal.
  434. #
  435. sub is_ord {
  436.     my ($val) = @_;
  437.  
  438.     if ((! defined($val)) || (length($val) == 0)) {
  439.         carp('Null ordinal; using 0x00');
  440.         return 0x00;
  441.     }
  442.     elsif (($val =~ /^[-+]?\d+$/)
  443.            && (($val > 255)
  444.                || ($val < 0))) {
  445.         carp('Illegal ordinal value (< 0 or > 255); using 255');
  446.         return 0xff;
  447.     }
  448.     elsif ($val !~ /^\+?\d+$/) {
  449.         if ($config->{strict_ordinals}) {
  450.             carp('Ordinal is not a positive integer; '
  451.                  . 'converting the first character');
  452.         }
  453.         return ord(substr($val, 0, 1));
  454.     }
  455.     return $val;
  456. }
  457.  
  458. 1; #this line is important and will help the module return a true value
  459.  
  460. __END__
  461.  
  462. =pod
  463.  
  464. =head1 BUGS
  465.  
  466. None known.
  467.  
  468. =head1 SUPPORT
  469.  
  470. The C<cpan-modules@Sourcery.Org> mailing list; send a message
  471. containing only the word C<subscribe> to cpan-modules-request@Sourcery.Org
  472. to join the list.
  473.  
  474. =head1 AUTHOR
  475.  
  476.  Ken Coar
  477.  CPAN ID: ROUS
  478.  Ken.Coar@Golux.Com
  479.  http://Ken.Coar.Org/
  480.  
  481. =end text
  482.  
  483. =head1 COPYRIGHT
  484.  
  485. This program is free software licensed under the...
  486.  
  487.     Apache Software License (Version 2.0)
  488.  
  489. The full text of the license can be found in the
  490. LICENCE file included with this module.
  491.  
  492. =head1 SEE ALSO
  493.  
  494. L<perl(1)>, and
  495. L<charnames(3pm)> (function C<viacode> in Perl 5.8.1 and later).
  496.  
  497. =cut
  498.  
  499. #
  500. # Local Variables:
  501. # mode: cperl
  502. # tab-width: 4
  503. # indent-tabs-mode: nil
  504. # End:
  505. #
  506.