home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gettext-0.10.24-src.tgz / tar.out / fsf / gettext / misc / gettext.perl < prev    next >
Text File  |  1996-09-28  |  3KB  |  87 lines
  1. # Toying at an interface between Perl and GNU gettext .mo format.
  2. # Copyright (C) 1995 Free Software Foundation, Inc.
  3. # François Pinard <pinard@iro.umontreal.ca>, 1995.
  4.  
  5. textdomain ("tar");
  6. print &_("Try \`%s --help\' for more information.\n");
  7. exit 0;
  8.  
  9. ## --------------------------------------------------------------- ##
  10. ## The `&textdomain (DOMAIN_NAME)' routine reads the given domain  ##
  11. ## into an associative array %_, able to later translate strings.  ##
  12. ## --------------------------------------------------------------- ##
  13.  
  14. sub textdomain
  15. {
  16.     local ($language, $catalog, $domain, $buffer);
  17.     local ($reverse);
  18.     local ($magic, $revision, $nstrings, $orig_tab_offset, $trans_tab_offset);
  19.     local ($orig_length, $orig_pointer, $trans_length, $trans_pointer);
  20.  
  21.     %_ = ();
  22.  
  23.     $language = $ENV{"LANG"};
  24.     return if ! $language;
  25.     $domain = $_[0];
  26.     $catalog = "/usr/local/share/locale/$language/LC_MESSAGES/$domain.mo";
  27.  
  28.     open (CATALOG, $catalog) || return;
  29.     sysread (CATALOG, $buffer, (stat CATALOG)[7]);
  30.     close CATALOG;
  31.  
  32.     $magic = unpack ("I", $buffer);
  33.     if (sprintf ("%x", $magic) eq "de120495")
  34.     {
  35.     $reverse = 1;
  36.     }
  37.     elsif (sprintf ("%x", $magic) ne "950412de")
  38.     {
  39.     die "Not a catalog file\n";
  40.     }
  41.  
  42.     $revision = &mo_format_value (4);
  43.     $nstrings = &mo_format_value (8);
  44.     $orig_tab_offset = &mo_format_value (12);
  45.     $trans_tab_offset = &mo_format_value (16);
  46.  
  47.     while ($nstrings-- > 0)
  48.     {
  49.     $orig_length = &mo_format_value ($orig_tab_offset);
  50.     $orig_pointer = &mo_format_value ($orig_tab_offset + 4);
  51.     $orig_tab_offset += 8;
  52.  
  53.     $trans_length = &mo_format_value ($trans_tab_offset);
  54.     $trans_pointer = &mo_format_value ($trans_tab_offset + 4);
  55.     $trans_tab_offset += 8;
  56.  
  57.     $_{substr ($buffer, $orig_pointer, $orig_length)}
  58.         = substr ($buffer, $trans_pointer, $trans_length);
  59.     }
  60. }
  61.  
  62. ## ----------------------------------------------------------------- ##
  63. ## The `&mo_format_value (ADDRESS)' routine returns the value at a   ##
  64. ## given address in the .mo format catalog, once read into $buffer   ##
  65. ## by `&textdomain'.  This is a service routine of `&textdomain',    ##
  66. ## which uses $buffer and $reverse variables local in that routine.  ##
  67. ## ----------------------------------------------------------------- ##
  68.  
  69. sub mo_format_value
  70. {
  71.     unpack ("i",
  72.         $reverse
  73.         ? pack ("c4", reverse unpack ("c4", substr ($buffer, $_[0], 4)))
  74.         : substr ($buffer, $_[0], 4));
  75. }
  76.  
  77. ## ------------------------------------------------------------ ##
  78. ## The `&_(STRING)' routine translates STRING if there is some  ##
  79. ## translation offered for it in the `%_' associative array, or ##
  80. ## return STRING itself, otherwize.                    ##
  81. ## ------------------------------------------------------------ ##
  82.  
  83. sub _
  84. {
  85.     defined $_{$_[0]} ? $_{$_[0]} : $_[0];
  86. }
  87.