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   1672 use strict;
  2         3  
  2         78  
15 2     2   10 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  2         4  
  2         150  
16              
17 2     2   419 use Bit::Vector;
  2         4  
  2         265  
18              
19             require Exporter;
20              
21             @ISA = qw(Exporter Bit::Vector);
22              
23             @EXPORT = qw();
24              
25             @EXPORT_OK = qw();
26              
27             $VERSION = '7.3';
28              
29             package Bit::Vector;
30              
31 2     2   11 use strict;
  2         5  
  2         126  
32 2     2   910 use Carp::Clan '^Bit::Vector\b';
  2         4155  
  2         49  
33              
34             my $Factor = log(10) / log(2);
35              
36             sub to_Oct
37             {
38 108 50   108 0 3387 croak('Usage: $vector->to_Oct();') unless (@_ == 1);
39 108         146 my($self) = @_;
40 108         136 my($string) = '';
41 108         139 local $@;
42              
43 108         191 eval { $string = reverse(join('', $self->Chunk_List_Read(3))); };
  108         4170  
44 108 50       1182 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         447 return $string;
52             }
53              
54             sub from_Oct
55             {
56 27 50   27 0 68 croak('Usage: $vector->from_Oct($string);') unless (@_ == 2);
57 27         39 my($self,$string) = @_;
58 27         40 local $@;
59              
60 27 50       128 if ($string =~ /^[0-7]+$/)
61             {
62 27         40 eval { $self->Chunk_List_Store(3, split(//, reverse($string))); };
  27         1668  
63 27 50       309 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         66 return $self;
76             }
77              
78             sub new_Oct
79             {
80 54 50   54 0 128 croak('Usage: Bit::Vector->new_Oct($bits,$string);') unless (@_ == 3);
81 54         83 my($class,$bits,$string) = @_;
82 54         54 my($self);
83 54         61 local $@;
84              
85 54 50       239 if ($string =~ /^[0-7]+$/)
86             {
87 54 100       124 unless (defined $bits) { $bits = 3 * length($string); }
  27         49  
88 54         82 eval { $self = Bit::Vector->new($bits); $self->Chunk_List_Store(3, split(//, reverse($string))); };
  54         801  
  54         2000  
89 54 50       588 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         156 return $self;
102             }
103              
104             sub String_Export
105             {
106 486 50 33 486 0 7221 croak('Usage: $vector->String_Export($type);') unless (@_ == 1 or @_ == 2);
107 486         646 my($self,$type) = @_;
108 486         577 my($string) = '';
109 486         586 local $@;
110              
111 486 50 33     8046 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         117 eval { $string = '0b' . $self->to_Bin(); };
  81         1334  
118             }
119             elsif ($type eq '2' or $type =~ /^o(?:ct)?$/i)
120             {
121 81         121 eval { $string = '0o' . reverse(join('', $self->Chunk_List_Read(3))); };
  81         3880  
122             }
123             elsif ($type eq '3' or $type =~ /^d(?:ec)?$/i)
124             {
125 81         128 eval { $string = $self->to_Dec(); };
  81         338189  
126             }
127             elsif ($type eq '4' or $type =~ /^(?:h(?:ex)?|x)$/i)
128             {
129 81         116 eval { $string = '0x' . $self->to_Hex(); };
  81         486  
130             }
131             elsif ($type eq '5' or $type =~ /^e(?:num)?$/i)
132             {
133 81         147 eval { $string = '{' . $self->to_Enum() . '}'; };
  81         1467  
134             }
135             elsif ($type eq '6' or $type =~ /^p(?:ack)?$/i)
136             {
137 81         119 eval { $string = ':' . $self->Size() . ':' . $self->Block_Read(); };
  81         631  
138             }
139             else
140             {
141 0         0 croak("unknown string type '$type'");
142             }
143 486 50       1937 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         1774 return $string;
151             }
152              
153             sub String_Import
154             {
155 306 50   306 0 104668 croak('Usage: $vector->String_Import($string);') unless (@_ == 2);
156 306         434 my($self,$string) = @_;
157 306         345 my($type) = 0;
158 306         312 local $@;
159              
160 306 100       4233 if ($string =~ /^(?:0[bB])?([01]+)$/)
    100          
    100          
    100          
    100          
    50          
161             {
162 54         71 $type = 1;
163 54         111 eval { $self->from_Bin($1); };
  54         442  
164             }
165             elsif ($string =~ /^(?:0[oO])?([0-7]+)$/)
166             {
167 45         46 $type = 2;
168 45         69 eval { $self->Chunk_List_Store(3, split(//, reverse($1))); };
  45         1677  
169             }
170             elsif ($string =~ /^(?:[+-])?[0-9]+$/)
171             {
172 54         130 $type = 3;
173 54         83 eval { $self->from_Dec($string); };
  54         18237  
174             }
175             elsif ($string =~ /^(?:0[hHxX])?([0-9A-Fa-f]+)$/)
176             {
177 45         53 $type = 4;
178 45         64 eval { $self->from_Hex($1); };
  45         300  
179             }
180             elsif ($string =~ /^[(<{\[]?([0-9]+(?:-[0-9]+)?(?:,[0-9]+(?:-[0-9]+)?)*)[)>}\]]?$/)
181             {
182 54         77 $type = 5;
183 54         81 eval { $self->from_Enum($1); };
  54         485  
184             }
185             elsif ($string =~ s!^:\d+:!!)
186             {
187 54         66 $type = 6;
188 54         610 eval { $self->Block_Store($string); };
  54         193  
189             }
190             else
191             {
192 0         0 croak("unknown string type");
193             }
194 306 50       1033 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         1392 return $type;
202             }
203              
204             sub new_String
205             {
206 324 50   324 0 696 croak('Usage: Bit::Vector->new_String($bits,$string);') unless (@_ == 3);
207 324         490 my($class,$bits,$string) = @_;
208 324         385 my($type) = 0;
209 324         294 my($self);
210 324         986 local $@;
211              
212 324 100       3514 if ($string =~ /^(?:0[bB])?([01]+)$/)
    100          
    100          
    100          
    100          
    50          
213             {
214 54         65 $type = 1;
215 54 100       105 unless (defined $bits) { $bits = length($1); }
  27         55  
216 54         72 eval { $self = Bit::Vector->new_Bin($bits,$1); };
  54         1130  
217             }
218             elsif ($string =~ /^(?:0[oO])?([0-7]+)$/)
219             {
220 54         62 $type = 2;
221 54 100       104 unless (defined $bits) { $bits = 3 * length($1); }
  27         51  
222 54         71 eval { $self = Bit::Vector->new($bits); $self->Chunk_List_Store(3, split(//, reverse($1))); };
  54         214  
  54         2717  
223             }
224             elsif ($string =~ /^(?:[+-])?([0-9]+)$/)
225             {
226 54         88 $type = 3;
227 54 100       109 unless (defined $bits) { $bits = int( length($1) * $Factor + 1 ); }
  27         94  
228 54         85 eval { $self = Bit::Vector->new_Dec($bits,$string); };
  54         17279  
229             }
230             elsif ($string =~ /^(?:0[hHxX])?([0-9A-Fa-f]+)$/)
231             {
232 54         81 $type = 4;
233 54 100       106 unless (defined $bits) { $bits = 4 * length($1); }
  27         61  
234 54         72 eval { $self = Bit::Vector->new_Hex($bits,$1); };
  54         417  
235             }
236             elsif ($string =~ /^[(<{\[]?([0-9]+(?:-[0-9]+)?(?:,[0-9]+(?:-[0-9]+)?)*)[)>}\]]?$/)
237             {
238 54         75 $type = 5;
239 54         134 $string = $1;
240 54 100       112 unless (defined $bits)
241             {
242 27         36 $bits = 0;
243 27 100       883 while ($string =~ /([0-9]+)/g) { $bits = $1 if ($1 > $bits); }
  958         5232  
244 27         38 $bits++;
245             }
246 54         82 eval { $self = Bit::Vector->new_Enum($bits,$string); };
  54         545  
247             }
248             elsif ($string =~ s!^:(\d+):!!)
249             {
250 54         73 $type = 6;
251 54 100       135 $bits = $1 unless (defined $bits);
252 54         71 eval { $self = Bit::Vector->new($bits); $self->Block_Store($string); };
  54         249  
  54         196  
253             }
254             else
255             {
256 0         0 croak("unknown string type");
257             }
258 324 50       1890 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       662 if (wantarray) { return($self,$type); }
  324         1200  
266 0           return $self;
267             }
268              
269             1;
270              
271             __END__