lib/bitvector/lib/Bit/Vector/String.pm

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