File Coverage

lib/Asterisk/LCR/Locale.pm
Criterion Covered Total %
statement 69 83 83.1
branch 22 34 64.7
condition 10 20 50.0
subroutine 12 14 85.7
pod 0 11 0.0
total 113 162 69.7


line stmt bran cond sub pod time code
1             package Asterisk::LCR::Locale;
2 1     1   59730 use base qw /Asterisk::LCR::Object/;
  1         79  
  1         684  
3 1     1   6 use warnings;
  1         1  
  1         110  
4 1     1   6 use strict;
  1         2  
  1         1887  
5              
6              
7             sub new
8             {
9 1     1 0 12 my $class = shift;
10 1   50     12 my $self = $class->SUPER::new (id => @_) || return;
11 1         5 $self->parse();
12 1         4 return $self;
13             }
14              
15              
16             # does global => local => global ($prefix) conversion
17             sub normalize
18             {
19 0     0 0 0 my $self = shift;
20 0         0 my $prefix = shift;
21 0         0 return $self->local_to_global ($self->global_to_local ($prefix));
22             }
23              
24              
25             sub global_to_local
26             {
27 10     10 0 24 my $self = shift;
28 10         19 my $num = shift;
29            
30 10   33     53 $self->{global_to_local_cache}->{$num} ||= do {
31 10         17 my $map = $self->{global_to_local};
32            
33 10         15 foreach my $prefix ( sort { length ($b) <=> length ($a) } keys %{$map} )
  550         565  
  10         71  
34             {
35 119         199 my $val = $map->{$prefix};
36 119 0       1454 $num =~ s/^_$prefix/_$val/ and return ($prefix =~ /^\d*$/) ? $num : $self->global_to_local ($num);
    50          
37 119 100       1519 $num =~ s/^$prefix/$map->{$prefix}/ and return ($prefix =~ /^\d*$/) ? $num : $self->global_to_local ($num);
    100          
38             }
39            
40 0         0 $num;
41             };
42            
43 0         0 return $self->{global_to_local_cache}->{$num};
44             }
45              
46              
47             sub local_to_global
48             {
49 6     6 0 23 my $self = shift;
50 6         10 my $num = shift;
51            
52 6   33     55 $self->{local_to_global_cache}->{$num} ||= do {
53 6         12 my $map = $self->{local_to_global};
54              
55 6         7 foreach my $prefix ( sort { length ($b) <=> length ($a) } keys %{$map} )
  132         134  
  6         31  
56             {
57 24         40 my $val = $map->{$prefix};
58 24 0       212 $num =~ s/^_$prefix/_$val/ and return ($prefix =~ /^\d*$/) ? $num : $self->local_to_global ($num);
    50          
59 24 50       259 $num =~ s/^$prefix/$map->{$prefix}/ and return ($prefix =~ /^\d*$/) ? $num : $self->local_to_global ($num);
    100          
60             }
61              
62 0         0 $num;
63             };
64            
65 0         0 return $self->{local_to_global_cache}->{$num};
66             }
67              
68              
69             sub validate
70             {
71 1     1 0 2 my $self = shift;
72 1 50       4 my $id = $self->id() or do {
73 0         0 die "asterisk/lcr/locale/id/undefined";
74 0         0 return 0;
75             };
76            
77 1 50       6 $self->path() or do {
78 0         0 die "asterisk/lcr/locale/id/no_path : $id";
79 0         0 return 0;
80             };
81            
82 1         7 return 1;
83             }
84              
85              
86             sub id
87             {
88 4     4 0 4 my $self = shift;
89 4         21 return $self->{id};
90             }
91              
92              
93             sub set_id
94             {
95 0     0 0 0 my $self = shift;
96 0         0 $self->{id} = shift;
97             }
98              
99              
100             sub parse
101             {
102 1     1 0 2 my $self = shift;
103 1         8 my @data = $self->get_lines();
104            
105 1         5 $self->{global_to_local} = {};
106 1         2 $self->{local_to_global} = {};
107            
108 1         3 foreach my $line (@data)
109             {
110 26         56 my ($local, $global) = $self->parse_line ($line);
111 26 100 66     95 defined $local and defined $global or next;
112 18 50       92 $self->{global_to_local}->{$global} = $local if ($local =~ /^\d*$/);
113 18 100       82 $self->{local_to_global}->{$local} = $global if ($global =~ /^\d*$/);
114             }
115             }
116              
117              
118             sub parse_line
119             {
120 26     26 0 31 my $self = shift;
121 26   100     58 my $line = shift || return;
122 23 100       68 $line =~ /^\s*\#/ and return;
123              
124 18         87 my ($one, $two) = $line =~ /\"(.*?)\".*\"(.*?)\"/;
125 18 50 33     82 return () unless (defined $one and defined $two);
126            
127 18         44 return ($one, $two);
128             }
129              
130              
131             sub get_lines
132             {
133 1     1 0 2 my $self = shift;
134 1         4 my $id = $self->id();
135 1   50     4 my $file = $self->path() || return ();
136            
137 1   50     43 open FP, "<$file" || die "Cannot read-open $file";
138 1         33 my @res = map { s/\r//g; s/\n//g; $_ } ;
  26         31  
  26         43  
  26         48  
139 1         17 close FP;
140            
141 1         11 return @res;
142             }
143              
144              
145             sub path
146             {
147 2     2 0 3 my $self = shift;
148              
149 2         9 my $path = $self->id();
150 2 50       11 $path = "Asterisk/LCR/Locale/" . $path . ".txt" unless ($path =~ /\/.*\.txt$/);
151              
152 2         5 for ('.', @INC)
153             {
154 6 100       144 -e "$_/$path" and return "$_/$path";
155             }
156 0           return;
157             }
158              
159              
160             1;
161              
162              
163             __END__