| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # ################################################################### Otakar Smrz, 2003/01/23 | 
| 2 |  |  |  |  |  |  | # | 
| 3 |  |  |  |  |  |  | # Encoding of Arabic: ArabTeX Notation by Klaus Lagally ##################################### | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | package Encode::Arabic::ArabTeX::ZDMG::RE; | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | our $VERSION = '14.1'; | 
| 8 |  |  |  |  |  |  |  | 
| 9 | 2 |  |  | 2 |  | 24119 | use 5.008; | 
|  | 2 |  |  |  |  | 7 |  | 
|  | 2 |  |  |  |  | 81 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 2 |  |  | 2 |  | 19 | use strict; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 67 |  | 
| 12 | 2 |  |  | 2 |  | 14 | use warnings; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 180 |  | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | sub import {            # perform import as if Encode were used one level before this module | 
| 15 | 2 |  |  | 2 |  | 17 | require Encode; | 
| 16 | 2 | 100 |  |  |  | 41 | push @Encode::ISA, 'Exporter' unless Encode->can('export_to_level'); | 
| 17 | 2 |  |  |  |  | 280 | Encode->export_to_level(1, @_); | 
| 18 |  |  |  |  |  |  | } | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 | 2 |  |  | 2 |  | 700 | use Encode::Encoding; | 
|  | 2 |  |  |  |  | 12562 |  | 
|  | 2 |  |  |  |  | 73 |  | 
| 22 | 2 |  |  | 2 |  | 13 | use base 'Encode::Encoding'; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 1349 |  | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | __PACKAGE__->Define('ZDMG-RE', 'ArabTeX-ZDMG-RE'); | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | our (%encode_used, %decode_used, @shams, @qamar); | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | sub encode ($$;$$) { | 
| 31 | 0 |  |  | 0 | 1 |  | my (undef, $text, $check, $mode) = @_; | 
| 32 |  |  |  |  |  |  |  | 
| 33 | 0 | 0 |  |  |  |  | $_[1] = '' if $check;                   # this is what in-place edit needs | 
| 34 |  |  |  |  |  |  |  | 
| 35 | 0 | 0 |  |  |  |  | $text = Encode::encode "utf8", $text if Encode::is_utf8($text); | 
| 36 |  |  |  |  |  |  |  | 
| 37 | 0 |  |  |  |  |  | return $text; | 
| 38 |  |  |  |  |  |  | } | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | sub decode ($$;$) { | 
| 42 | 0 |  |  | 0 | 1 |  | my (undef, $text, $check) = @_; | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 0 | 0 |  |  |  |  | $_[1] = '' if $check;                   # this is what in-place edit needs | 
| 45 |  |  |  |  |  |  |  | 
| 46 | 0 | 0 |  |  |  |  | $text = Encode::decode "utf8", $text unless Encode::is_utf8($text); | 
| 47 |  |  |  |  |  |  |  | 
| 48 | 0 |  |  |  |  |  | for ($text) { | 
| 49 |  |  |  |  |  |  |  | 
| 50 | 0 |  |  |  |  |  | s/NY/n/g; | 
| 51 | 0 |  |  |  |  |  | s/UA/u\x{0304}/g; | 
| 52 | 0 |  |  |  |  |  | s/WA/w/g; | 
| 53 | 0 |  |  |  |  |  | s/_a/a\x{0304}/g; | 
| 54 |  |  |  |  |  |  |  | 
| 55 | 0 |  |  |  |  |  | s/N/n/g; | 
| 56 | 0 |  |  |  |  |  | s/Y/a\x{0304}/g; | 
| 57 | 0 |  |  |  |  |  | s/T/t/g; | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | #s/y/j/g; | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 0 |  |  |  |  |  | s/\\cap\s+([\._\^]?)([a-zAIU])/$1\*$2/g; | 
| 62 | 0 |  |  |  |  |  | s/\\cap\s+(['`])([a-zAIUEO])/\*$1\*$2/g; | 
| 63 |  |  |  |  |  |  |  | 
| 64 | 0 |  |  |  |  |  | s/\.(\*?[hsdtz])/$1\x{0323}/g; | 
| 65 | 0 |  |  |  |  |  | s/\.(\*?g)/$1\x{0307}/g; | 
| 66 |  |  |  |  |  |  |  | 
| 67 | 0 |  |  |  |  |  | s/_(\*?[td])/$1\x{0331}/g; | 
| 68 | 0 |  |  |  |  |  | s/_(\*?)h/$1\x{032E}/g; | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | #s/_(\*?)h/$1ch/g; | 
| 71 |  |  |  |  |  |  |  | 
| 72 | 0 |  |  |  |  |  | s/\^(\*?[gs])/$1\x{030C}/g; | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | #s/\^(\*?s)/\\v{$1}/g; | 
| 75 |  |  |  |  |  |  | #s/\^(\*?)g/$1d\\v{z}/g; | 
| 76 |  |  |  |  |  |  |  | 
| 77 | 0 |  |  |  |  |  | s/(? | 
| 78 | 0 |  |  |  |  |  | s/(? | 
| 79 | 0 |  |  |  |  |  | s/\*([AIUEO])/$1\x{0304}/g; | 
| 80 |  |  |  |  |  |  |  | 
| 81 | 0 |  |  |  |  |  | s/\*?'/\x{02BE}/g; | 
| 82 | 0 |  |  |  |  |  | s/\*?`/\x{02BF}/g; | 
| 83 |  |  |  |  |  |  |  | 
| 84 | 0 |  |  |  |  |  | s/\*([a-z])/\u$1/g; | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  |  | 
| 87 | 0 |  |  |  |  |  | return $text; | 
| 88 |  |  |  |  |  |  | } | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | 1; | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | __END__ |