Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Bit::Vector::String; |
2 | ||
3 | use strict; | |
4 | use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); | |
5 | ||
6 | use Bit::Vector; | |
7 | ||
8 | require Exporter; | |
9 | ||
10 | @ISA = qw(Exporter Bit::Vector); | |
11 | ||
12 | @EXPORT = qw(); | |
13 | ||
14 | @EXPORT_OK = qw(); | |
15 | ||
16 | $VERSION = '6.4'; | |
17 | ||
18 | package Bit::Vector; | |
19 | ||
20 | use strict; | |
21 | use Carp::Clan '^Bit::Vector\b'; | |
22 | ||
23 | my $Factor = log(10) / log(2); | |
24 | ||
25 | sub to_Oct | |
26 | { | |
27 | croak('Usage: $vector->to_Oct();') unless (@_ == 1); | |
28 | my($self) = @_; | |
29 | my($string) = ''; | |
30 | local $@; | |
31 | ||
32 | eval { $string = reverse(join('', $self->Chunk_List_Read(3))); }; | |
33 | if ($@) | |
34 | { | |
35 | $string = $@; | |
36 | $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!; | |
37 | $string =~ s!\s+at\s.*$!!; | |
38 | croak($string); | |
39 | } | |
40 | return $string; | |
41 | } | |
42 | ||
43 | sub from_Oct | |
44 | { | |
45 | croak('Usage: $vector->from_Oct($string);') unless (@_ == 2); | |
46 | my($self,$string) = @_; | |
47 | local $@; | |
48 | ||
49 | if ($string =~ /^[0-7]+$/) | |
50 | { | |
51 | eval { $self->Chunk_List_Store(3, split(//, reverse($string))); }; | |
52 | if ($@) | |
53 | { | |
54 | $string = $@; | |
55 | $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!; | |
56 | $string =~ s!\s+at\s.*$!!; | |
57 | croak($string); | |
58 | } | |
59 | } | |
60 | else | |
61 | { | |
62 | croak("unknown string type"); | |
63 | } | |
64 | return $self; | |
65 | } | |
66 | ||
67 | sub new_Oct | |
68 | { | |
69 | croak('Usage: Bit::Vector->new_Oct($bits,$string);') unless (@_ == 3); | |
70 | my($class,$bits,$string) = @_; | |
71 | my($self); | |
72 | local $@; | |
73 | ||
74 | if ($string =~ /^[0-7]+$/) | |
75 | { | |
76 | unless (defined $bits) { $bits = 3 * length($string); } | |
77 | eval { $self = Bit::Vector->new($bits); $self->Chunk_List_Store(3, split(//, reverse($string))); }; | |
78 | if ($@) | |
79 | { | |
80 | $string = $@; | |
81 | $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!; | |
82 | $string =~ s!\s+at\s.*$!!; | |
83 | croak($string); | |
84 | } | |
85 | } | |
86 | else | |
87 | { | |
88 | croak("unknown string type"); | |
89 | } | |
90 | return $self; | |
91 | } | |
92 | ||
93 | sub String_Export | |
94 | { | |
95 | croak('Usage: $vector->String_Export($type);') unless (@_ == 1 or @_ == 2); | |
96 | my($self,$type) = @_; | |
97 | my($string) = ''; | |
98 | local $@; | |
99 | ||
100 | if (not defined $type or not $type) | |
101 | { | |
102 | eval { $string = '0x' . $self->to_Hex(); }; | |
103 | } | |
104 | elsif ($type eq '1' or $type =~ /^b(?:in)?$/i) | |
105 | { | |
106 | eval { $string = '0b' . $self->to_Bin(); }; | |
107 | } | |
108 | elsif ($type eq '2' or $type =~ /^o(?:ct)?$/i) | |
109 | { | |
110 | eval { $string = '0o' . reverse(join('', $self->Chunk_List_Read(3))); }; | |
111 | } | |
112 | elsif ($type eq '3' or $type =~ /^d(?:ec)?$/i) | |
113 | { | |
114 | eval { $string = $self->to_Dec(); }; | |
115 | } | |
116 | elsif ($type eq '4' or $type =~ /^(?:h(?:ex)?|x)$/i) | |
117 | { | |
118 | eval { $string = '0x' . $self->to_Hex(); }; | |
119 | } | |
120 | elsif ($type eq '5' or $type =~ /^e(?:num)?$/i) | |
121 | { | |
122 | eval { $string = '{' . $self->to_Enum() . '}'; }; | |
123 | } | |
124 | elsif ($type eq '6' or $type =~ /^p(?:ack)?$/i) | |
125 | { | |
126 | eval { $string = ':' . $self->Size() . ':' . $self->Block_Read(); }; | |
127 | } | |
128 | else | |
129 | { | |
130 | croak("unknown string type '$type'"); | |
131 | } | |
132 | if ($@) | |
133 | { | |
134 | $string = $@; | |
135 | $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!; | |
136 | $string =~ s!\s+at\s.*$!!; | |
137 | croak($string); | |
138 | } | |
139 | return $string; | |
140 | } | |
141 | ||
142 | sub String_Import | |
143 | { | |
144 | croak('Usage: $vector->String_Import($string);') unless (@_ == 2); | |
145 | my($self,$string) = @_; | |
146 | my($type) = 0; | |
147 | local $@; | |
148 | ||
149 | if ($string =~ /^(?:0[bB])?([01]+)$/) | |
150 | { | |
151 | $type = 1; | |
152 | eval { $self->from_Bin($1); }; | |
153 | } | |
154 | elsif ($string =~ /^(?:0[oO])?([0-7]+)$/) | |
155 | { | |
156 | $type = 2; | |
157 | eval { $self->Chunk_List_Store(3, split(//, reverse($1))); }; | |
158 | } | |
159 | elsif ($string =~ /^(?:[+-])?[0-9]+$/) | |
160 | { | |
161 | $type = 3; | |
162 | eval { $self->from_Dec($string); }; | |
163 | } | |
164 | elsif ($string =~ /^(?:0[hHxX])?([0-9A-Fa-f]+)$/) | |
165 | { | |
166 | $type = 4; | |
167 | eval { $self->from_Hex($1); }; | |
168 | } | |
169 | elsif ($string =~ /^[(<{\[]?([0-9]+(?:-[0-9]+)?(?:,[0-9]+(?:-[0-9]+)?)*)[)>}\]]?$/) | |
170 | { | |
171 | $type = 5; | |
172 | eval { $self->from_Enum($1); }; | |
173 | } | |
174 | elsif ($string =~ s!^:\d+:!!) | |
175 | { | |
176 | $type = 6; | |
177 | eval { $self->Block_Store($string); }; | |
178 | } | |
179 | else | |
180 | { | |
181 | croak("unknown string type"); | |
182 | } | |
183 | if ($@) | |
184 | { | |
185 | $string = $@; | |
186 | $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!; | |
187 | $string =~ s!\s+at\s.*$!!; | |
188 | croak($string); | |
189 | } | |
190 | return $type; | |
191 | } | |
192 | ||
193 | sub new_String | |
194 | { | |
195 | croak('Usage: Bit::Vector->new_String($bits,$string);') unless (@_ == 3); | |
196 | my($class,$bits,$string) = @_; | |
197 | my($type) = 0; | |
198 | my($self); | |
199 | local $@; | |
200 | ||
201 | if ($string =~ /^(?:0[bB])?([01]+)$/) | |
202 | { | |
203 | $type = 1; | |
204 | unless (defined $bits) { $bits = length($1); } | |
205 | eval { $self = Bit::Vector->new_Bin($bits,$1); }; | |
206 | } | |
207 | elsif ($string =~ /^(?:0[oO])?([0-7]+)$/) | |
208 | { | |
209 | $type = 2; | |
210 | unless (defined $bits) { $bits = 3 * length($1); } | |
211 | eval { $self = Bit::Vector->new($bits); $self->Chunk_List_Store(3, split(//, reverse($1))); }; | |
212 | } | |
213 | elsif ($string =~ /^(?:[+-])?([0-9]+)$/) | |
214 | { | |
215 | $type = 3; | |
216 | unless (defined $bits) { $bits = int( length($1) * $Factor + 1 ); } | |
217 | eval { $self = Bit::Vector->new_Dec($bits,$string); }; | |
218 | } | |
219 | elsif ($string =~ /^(?:0[hHxX])?([0-9A-Fa-f]+)$/) | |
220 | { | |
221 | $type = 4; | |
222 | unless (defined $bits) { $bits = 4 * length($1); } | |
223 | eval { $self = Bit::Vector->new_Hex($bits,$1); }; | |
224 | } | |
225 | elsif ($string =~ /^[(<{\[]?([0-9]+(?:-[0-9]+)?(?:,[0-9]+(?:-[0-9]+)?)*)[)>}\]]?$/) | |
226 | { | |
227 | $type = 5; | |
228 | $string = $1; | |
229 | unless (defined $bits) | |
230 | { | |
231 | $bits = 0; | |
232 | while ($string =~ /([0-9]+)/g) { $bits = $1 if ($1 > $bits); } | |
233 | $bits++; | |
234 | } | |
235 | eval { $self = Bit::Vector->new_Enum($bits,$string); }; | |
236 | } | |
237 | elsif ($string =~ s!^:(\d+):!!) | |
238 | { | |
239 | $type = 6; | |
240 | $bits = $1 unless (defined $bits); | |
241 | eval { $self = Bit::Vector->new($bits); $self->Block_Store($string); }; | |
242 | } | |
243 | else | |
244 | { | |
245 | croak("unknown string type"); | |
246 | } | |
247 | if ($@) | |
248 | { | |
249 | $string = $@; | |
250 | $string =~ s!^[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s+!!; | |
251 | $string =~ s!\s+at\s.*$!!; | |
252 | croak($string); | |
253 | } | |
254 | if (wantarray) { return($self,$type); } | |
255 | return $self; | |
256 | } | |
257 | ||
258 | 1; | |
259 | ||
260 | __END__ | |
261 |