File Coverage

blib/lib/Bit/Vector/String.pm
Criterion Covered Total %
statement 131 163 80.3
branch 65 84 77.3
condition 13 24 54.1
subroutine 11 11 100.0
pod 0 6 0.0
total 220 288 76.3


line stmt bran cond sub pod time code
1              
2             ###############################################################################
3             ## ##
4             ## Copyright (c) 2004 - 2013 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   995 use strict;
  2         4  
  2         90  
15 2     2   10 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  2         2  
  2         143  
16              
17 2     2   620 use Bit::Vector;
  2         5  
  2         187  
18              
19             require Exporter;
20              
21             @ISA = qw(Exporter Bit::Vector);
22              
23             @EXPORT = qw();
24              
25             @EXPORT_OK = qw();
26              
27             $VERSION = '7.4';
28              
29             package Bit::Vector;
30              
31 2     2   10 use strict;
  2         3  
  2         55  
32 2     2   477 use Carp::Clan '^Bit::Vector\b';
  2         3845  
  2         12  
33              
34             my $Factor = log(10) / log(2);
35              
36             sub to_Oct
37             {
38 108 50   108 0 1723 croak('Usage: $vector->to_Oct();') unless (@_ == 1);
39 108         113 my($self) = @_;
40 108         101 my($string) = '';
41 108         92 local $@;
42              
43 108         115 eval { $string = reverse(join('', $self->Chunk_List_Read(3))); };
  108         2839  
44 108 50       730 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         277 return $string;
52             }
53              
54             sub from_Oct
55             {
56 27 50   27 0 49 croak('Usage: $vector->from_Oct($string);') unless (@_ == 2);
57 27         35 my($self,$string) = @_;
58 27         26 local $@;
59              
60 27 50       112 if ($string =~ /^[0-7]+$/)
61             {
62 27         33 eval { $self->Chunk_List_Store(3, split(//, reverse($string))); };
  27         671  
63 27 50       220 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         61 return $self;
76             }
77              
78             sub new_Oct
79             {
80 54 50   54 0 97 croak('Usage: Bit::Vector->new_Oct($bits,$string);') unless (@_ == 3);
81 54         67 my($class,$bits,$string) = @_;
82 54         44 my($self);
83 54         41 local $@;
84              
85 54 50       203 if ($string =~ /^[0-7]+$/)
86             {
87 54 100       92 unless (defined $bits) { $bits = 3 * length($string); }
  27         80  
88 54         53 eval { $self = Bit::Vector->new($bits); $self->Chunk_List_Store(3, split(//, reverse($string))); };
  54         183  
  54         1294  
89 54 50       354 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         107 return $self;
102             }
103              
104             sub String_Export
105             {
106 486 50 33 486 0 5294 croak('Usage: $vector->String_Export($type);') unless (@_ == 1 or @_ == 2);
107 486         494 my($self,$type) = @_;
108 486         422 my($string) = '';
109 486         361 local $@;
110              
111 486 50 33     5913 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         95 eval { $string = '0b' . $self->to_Bin(); };
  81         670  
118             }
119             elsif ($type eq '2' or $type =~ /^o(?:ct)?$/i)
120             {
121 81         99 eval { $string = '0o' . reverse(join('', $self->Chunk_List_Read(3))); };
  81         2033  
122             }
123             elsif ($type eq '3' or $type =~ /^d(?:ec)?$/i)
124             {
125 81         95 eval { $string = $self->to_Dec(); };
  81         59529  
126             }
127             elsif ($type eq '4' or $type =~ /^(?:h(?:ex)?|x)$/i)
128             {
129 81         101 eval { $string = '0x' . $self->to_Hex(); };
  81         357  
130             }
131             elsif ($type eq '5' or $type =~ /^e(?:num)?$/i)
132             {
133 81         86 eval { $string = '{' . $self->to_Enum() . '}'; };
  81         1292  
134             }
135             elsif ($type eq '6' or $type =~ /^p(?:ack)?$/i)
136             {
137 81         96 eval { $string = ':' . $self->Size() . ':' . $self->Block_Read(); };
  81         440  
138             }
139             else
140             {
141 0         0 croak("unknown string type '$type'");
142             }
143 486 50       1293 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         1238 return $string;
151             }
152              
153             sub String_Import
154             {
155 306 50   306 0 21260 croak('Usage: $vector->String_Import($string);') unless (@_ == 2);
156 306         304 my($self,$string) = @_;
157 306         252 my($type) = 0;
158 306         231 local $@;
159              
160 306 100       2502 if ($string =~ /^(?:0[bB])?([01]+)$/)
    100          
    100          
    100          
    100          
    50          
161             {
162 54         65 $type = 1;
163 54         65 eval { $self->from_Bin($1); };
  54         394  
164             }
165             elsif ($string =~ /^(?:0[oO])?([0-7]+)$/)
166             {
167 45         46 $type = 2;
168 45         46 eval { $self->Chunk_List_Store(3, split(//, reverse($1))); };
  45         1073  
169             }
170             elsif ($string =~ /^(?:[+-])?[0-9]+$/)
171             {
172 54         45 $type = 3;
173 54         56 eval { $self->from_Dec($string); };
  54         6433  
174             }
175             elsif ($string =~ /^(?:0[hHxX])?([0-9A-Fa-f]+)$/)
176             {
177 45         38 $type = 4;
178 45         43 eval { $self->from_Hex($1); };
  45         222  
179             }
180             elsif ($string =~ /^[(<{\[]?([0-9]+(?:-[0-9]+)?(?:,[0-9]+(?:-[0-9]+)?)*)[)>}\]]?$/)
181             {
182 54         53 $type = 5;
183 54         57 eval { $self->from_Enum($1); };
  54         323  
184             }
185             elsif ($string =~ s!^:\d+:!!)
186             {
187 54         50 $type = 6;
188 54         57 eval { $self->Block_Store($string); };
  54         600  
189             }
190             else
191             {
192 0         0 croak("unknown string type");
193             }
194 306 50       667 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         522 return $type;
202             }
203              
204             sub new_String
205             {
206 324 50   324 0 548 croak('Usage: Bit::Vector->new_String($bits,$string);') unless (@_ == 3);
207 324         325 my($class,$bits,$string) = @_;
208 324         317 my($type) = 0;
209 324         246 my($self);
210 324         244 local $@;
211              
212 324 100       2690 if ($string =~ /^(?:0[bB])?([01]+)$/)
    100          
    100          
    100          
    100          
    50          
213             {
214 54         48 $type = 1;
215 54 100       103 unless (defined $bits) { $bits = length($1); }
  27         44  
216 54         56 eval { $self = Bit::Vector->new_Bin($bits,$1); };
  54         405  
217             }
218             elsif ($string =~ /^(?:0[oO])?([0-7]+)$/)
219             {
220 54         46 $type = 2;
221 54 100       100 unless (defined $bits) { $bits = 3 * length($1); }
  27         48  
222 54         56 eval { $self = Bit::Vector->new($bits); $self->Chunk_List_Store(3, split(//, reverse($1))); };
  54         150  
  54         1325  
223             }
224             elsif ($string =~ /^(?:[+-])?([0-9]+)$/)
225             {
226 54         44 $type = 3;
227 54 100       100 unless (defined $bits) { $bits = int( length($1) * $Factor + 1 ); }
  27         79  
228 54         51 eval { $self = Bit::Vector->new_Dec($bits,$string); };
  54         6602  
229             }
230             elsif ($string =~ /^(?:0[hHxX])?([0-9A-Fa-f]+)$/)
231             {
232 54         58 $type = 4;
233 54 100       90 unless (defined $bits) { $bits = 4 * length($1); }
  27         44  
234 54         57 eval { $self = Bit::Vector->new_Hex($bits,$1); };
  54         357  
235             }
236             elsif ($string =~ /^[(<{\[]?([0-9]+(?:-[0-9]+)?(?:,[0-9]+(?:-[0-9]+)?)*)[)>}\]]?$/)
237             {
238 54         47 $type = 5;
239 54         109 $string = $1;
240 54 100       94 unless (defined $bits)
241             {
242 27         23 $bits = 0;
243 27 100       98 while ($string =~ /([0-9]+)/g) { $bits = $1 if ($1 > $bits); }
  958         2545  
244 27         36 $bits++;
245             }
246 54         53 eval { $self = Bit::Vector->new_Enum($bits,$string); };
  54         347  
247             }
248             elsif ($string =~ s!^:(\d+):!!)
249             {
250 54         54 $type = 6;
251 54 100       121 $bits = $1 unless (defined $bits);
252 54         46 eval { $self = Bit::Vector->new($bits); $self->Block_Store($string); };
  54         178  
  54         144  
253             }
254             else
255             {
256 0         0 croak("unknown string type");
257             }
258 324 50       788 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       438 if (wantarray) { return($self,$type); }
  324         866  
266 0           return $self;
267             }
268              
269             1;
270              
271             __END__