File Coverage

blib/lib/Bit/Vector/String.pm
Criterion Covered Total %
statement 131 163 80.4
branch 65 84 77.4
condition 13 24 54.2
subroutine 11 11 100.0
pod n/a
total 220 282 78.0


line stmt bran cond sub pod time code
1              
2             ###############################################################################
3             ## ##
4             ## Copyright (c) 2004 by Steffen Beyer. ##
5             ## All rights reserved. ##
6             ## ##
7             ## This package is free software; you can redistribute it ##
8             ## and/or modify it under the same terms as Perl itself. ##
9             ## ##
10             ###############################################################################
11              
12             package Bit::Vector::String;
13              
14 2     2   29 use strict;
  2         27  
  2         31  
15 2     2   29 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  2         18  
  2         28  
16              
17 2     2   50 use Bit::Vector;
  2         20  
  2         37  
18              
19             require Exporter;
20              
21             @ISA = qw(Exporter Bit::Vector);
22              
23             @EXPORT = qw();
24              
25             @EXPORT_OK = qw();
26              
27             $VERSION = '6.4';
28              
29             package Bit::Vector;
30              
31 2     2   61 use strict;
  2         46  
  2         26  
32 2     2   52 use Carp::Clan '^Bit::Vector\b';
  2         18  
  2         36  
33              
34             my $Factor = log(10) / log(2);
35              
36             sub to_Oct
37             {
38 108 50   108   8617     croak('Usage: $vector->to_Oct();') unless (@_ == 1);
39 108         1019     my($self) = @_;
40 108         1617     my($string) = '';
41 108         984     local $@;
42              
43 108         1150     eval { $string = reverse(join('', $self->Chunk_List_Read(3))); };
  108         11800  
44 108 50       2793     if ($@)
45                 {
46 0         0         $string = $@;
47 0         0         $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!;
48 0         0         $string =~ s!\s+at\s.*$!!;
49 0         0         croak($string);
50                 }
51 108         1540     return $string;
52             }
53              
54             sub from_Oct
55             {
56 27 50   27   387     croak('Usage: $vector->from_Oct($string);') unless (@_ == 2);
57 27         294     my($self,$string) = @_;
58 27         224     local $@;
59              
60 27 50       370     if ($string =~ /^[0-7]+$/)
61                 {
62 27         279         eval { $self->Chunk_List_Store(3, split(//, reverse($string))); };
  27         2847  
63 27 50       627         if ($@)
64                     {
65 0         0             $string = $@;
66 0         0             $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!;
67 0         0             $string =~ s!\s+at\s.*$!!;
68 0         0             croak($string);
69                     }
70                 }
71                 else
72                 {
73 0         0         croak("unknown string type");
74                 }
75 27         337     return $self;
76             }
77              
78             sub new_Oct
79             {
80 54 50   54   529     croak('Usage: Bit::Vector->new_Oct($bits,$string);') unless (@_ == 3);
81 54         535     my($class,$bits,$string) = @_;
82 54         416     my($self);
83 54         463     local $@;
84              
85 54 50       668     if ($string =~ /^[0-7]+$/)
86                 {
87 54 100       879         unless (defined $bits) { $bits = 3 * length($string); }
  27         271  
88 54         466         eval { $self = Bit::Vector->new($bits); $self->Chunk_List_Store(3, split(//, reverse($string))); };
  54         908  
  54         5718  
89 54 50       1254         if ($@)
90                     {
91 0         0             $string = $@;
92 0         0             $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!;
93 0         0             $string =~ s!\s+at\s.*$!!;
94 0         0             croak($string);
95                     }
96                 }
97                 else
98                 {
99 0         0         croak("unknown string type");
100                 }
101 54         584     return $self;
102             }
103              
104             sub String_Export
105             {
106 486 50 33 486   21026     croak('Usage: $vector->String_Export($type);') unless (@_ == 1 or @_ == 2);
107 486         5902     my($self,$type) = @_;
108 486         4517     my($string) = '';
109 486         4345     local $@;
110              
111 486 50 33     15055     if (not defined $type or not $type)
    100 66        
    100 66        
    100 66        
    100 66        
    100 66        
    50 33        
112                 {
113 0         0         eval { $string = '0x' . $self->to_Hex(); };
  0         0  
114                 }
115                 elsif ($type eq '1' or $type =~ /^b(?:in)?$/i)
116                 {
117 81         733         eval { $string = '0b' . $self->to_Bin(); };
  81         2407  
118                 }
119                 elsif ($type eq '2' or $type =~ /^o(?:ct)?$/i)
120                 {
121 81         715         eval { $string = '0o' . reverse(join('', $self->Chunk_List_Read(3))); };
  81         7225  
122                 }
123                 elsif ($type eq '3' or $type =~ /^d(?:ec)?$/i)
124                 {
125 81         779         eval { $string = $self->to_Dec(); };
  81         192691  
126                 }
127                 elsif ($type eq '4' or $type =~ /^(?:h(?:ex)?|x)$/i)
128                 {
129 81         732         eval { $string = '0x' . $self->to_Hex(); };
  81         1170  
130                 }
131                 elsif ($type eq '5' or $type =~ /^e(?:num)?$/i)
132                 {
133 81         992         eval { $string = '{' . $self->to_Enum() . '}'; };
  81         2320  
134                 }
135                 elsif ($type eq '6' or $type =~ /^p(?:ack)?$/i)
136                 {
137 81         718         eval { $string = ':' . $self->Size() . ':' . $self->Block_Read(); };
  81         1253  
138                 }
139                 else
140                 {
141 0         0         croak("unknown string type '$type'");
142                 }
143 486 50       52491     if ($@)
144                 {
145 0         0         $string = $@;
146 0         0         $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!;
147 0         0         $string =~ s!\s+at\s.*$!!;
148 0         0         croak($string);
149                 }
150 486         6845     return $string;
151             }
152              
153             sub String_Import
154             {
155 306 50   306   67497     croak('Usage: $vector->String_Import($string);') unless (@_ == 2);
156 306         2820     my($self,$string) = @_;
157 306         2634     my($type) = 0;
158 306         2773     local $@;
159              
160 306 100       7313     if ($string =~ /^(?:0[bB])?([01]+)$/)
    100          
    100          
    100          
    100          
    50          
161                 {
162 54         469         $type = 1;
163 54         460         eval { $self->from_Bin($1); };
  54         840  
164                 }
165                 elsif ($string =~ /^(?:0[oO])?([0-7]+)$/)
166                 {
167 45         358         $type = 2;
168 45         378         eval { $self->Chunk_List_Store(3, split(//, reverse($1))); };
  45         5911  
169                 }
170                 elsif ($string =~ /^(?:[+-])?[0-9]+$/)
171                 {
172 54         458         $type = 3;
173 54         463         eval { $self->from_Dec($string); };
  54         13434  
174                 }
175                 elsif ($string =~ /^(?:0[hHxX])?([0-9A-Fa-f]+)$/)
176                 {
177 45         444         $type = 4;
178 45         378         eval { $self->from_Hex($1); };
  45         651  
179                 }
180                 elsif ($string =~ /^[(<{\[]?([0-9]+(?:-[0-9]+)?(?:,[0-9]+(?:-[0-9]+)?)*)[)>}\]]?$/)
181                 {
182 54         608         $type = 5;
183 54         486         eval { $self->from_Enum($1); };
  54         834  
184                 }
185                 elsif ($string =~ s!^:\d+:!!)
186                 {
187 54         442         $type = 6;
188 54         446         eval { $self->Block_Store($string); };
  54         591  
189                 }
190                 else
191                 {
192 0         0         croak("unknown string type");
193                 }
194 306 50       3535     if ($@)
195                 {
196 0         0         $string = $@;
197 0         0         $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!;
198 0         0         $string =~ s!\s+at\s.*$!!;
199 0         0         croak($string);
200                 }
201 306         3989     return $type;
202             }
203              
204             sub new_String
205             {
206 324 50   324   3375     croak('Usage: Bit::Vector->new_String($bits,$string);') unless (@_ == 3);
207 324         3181     my($class,$bits,$string) = @_;
208 324         10448     my($type) = 0;
209 324         2565     my($self);
210 324         2581     local $@;
211              
212 324 100       7000     if ($string =~ /^(?:0[bB])?([01]+)$/)
    100          
    100          
    100          
    100          
    50          
213                 {
214 54         499         $type = 1;
215 54 100       588         unless (defined $bits) { $bits = length($1); }
  27         269  
216 54         495         eval { $self = Bit::Vector->new_Bin($bits,$1); };
  54         986  
217                 }
218                 elsif ($string =~ /^(?:0[oO])?([0-7]+)$/)
219                 {
220 54         1084         $type = 2;
221 54 100       510         unless (defined $bits) { $bits = 3 * length($1); }
  27         262  
222 54         519         eval { $self = Bit::Vector->new($bits); $self->Chunk_List_Store(3, split(//, reverse($1))); };
  54         959  
  54         5542  
223                 }
224                 elsif ($string =~ /^(?:[+-])?([0-9]+)$/)
225                 {
226 54         444         $type = 3;
227 54 100       493         unless (defined $bits) { $bits = int( length($1) * $Factor + 1 ); }
  27         318  
228 54         464         eval { $self = Bit::Vector->new_Dec($bits,$string); };
  54         12251  
229                 }
230                 elsif ($string =~ /^(?:0[hHxX])?([0-9A-Fa-f]+)$/)
231                 {
232 54         469         $type = 4;
233 54 100       522         unless (defined $bits) { $bits = 4 * length($1); }
  27         255  
234 54         484         eval { $self = Bit::Vector->new_Hex($bits,$1); };
  54         988  
235                 }
236                 elsif ($string =~ /^[(<{\[]?([0-9]+(?:-[0-9]+)?(?:,[0-9]+(?:-[0-9]+)?)*)[)>}\]]?$/)
237                 {
238 54         442         $type = 5;
239 54         582         $string = $1;
240 54 100       498         unless (defined $bits)
241                     {
242 27         218             $bits = 0;
243 27 100       342             while ($string =~ /([0-9]+)/g) { $bits = $1 if ($1 > $bits); }
  958         16456  
244 27         230             $bits++;
245                     }
246 54         572         eval { $self = Bit::Vector->new_Enum($bits,$string); };
  54         857  
247                 }
248                 elsif ($string =~ s!^:(\d+):!!)
249                 {
250 54         520         $type = 6;
251 54 100       536         $bits = $1 unless (defined $bits);
252 54         531         eval { $self = Bit::Vector->new($bits); $self->Block_Store($string); };
  54         625  
  54         631  
253                 }
254                 else
255                 {
256 0         0         croak("unknown string type");
257                 }
258 324 50       3965     if ($@)
259                 {
260 0         0         $string = $@;
261 0         0         $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!;
262 0         0         $string =~ s!\s+at\s.*$!!;
263 0         0         croak($string);
264                 }
265 324 50       2931     if (wantarray) { return($self,$type); }
  324         4045  
266 0               return $self;
267             }
268              
269             1;
270              
271             __END__
272            
273