branches/erry-devel/SrSv/Insp/UUID.pm

   1 #       This file is part of SurrealServices.
   2 #
   3 #       SurrealServices is free software; you can redistribute it and/or modify
   4 #       it under the terms of the GNU Lesser General Public License version 2.1,
   5 #       as published by the Free Software Foundation.
   6 #
   7 #       SurrealServices is distributed in the hope that it will be useful,
   8 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
   9 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10 #       GNU General Public License for more details.
  11 #
  12 #       You should have received a copy of the GNU Lesser General Public License
  13 #       along with SurrealServices; if not, write to the Free Software
  14 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  15
  16
  17 #=cut
  18
  19 #THIS CODE IS alpha only, and untested. Don't just trust it blindly.
  20
  21 #=cut
  22
  23 package SrSv::Insp::UUID;
  24
  25 use strict;
  26 use warnings;
  27
  28
  29 use Exporter qw( import );
  30 BEGIN {
  31         our @EXPORT = qw( decodeUUID encodeUUID );
  32 }
  33
  34 use constant {
  35         ORD_A => ord('A'),
  36         SID_BITS => 24,
  37         UID_BITS => 40,
  38         CHAR_BITS => 6,
  39         CHAR_MASK => 63,
  40         # the 24 here is SID_BITS, the 40 is UID_BITS
  41         # but you can't reference a constant in a constant.
  42         SID_BITMASK => (((2**24)-1) << 40),
  43         UID_BITMASK => ~(((2**24)-1) << 40),
  44 };
  45
  46 sub isAlpha($) {
  47         my ($char) = @_;
  48         return ($char =~ /^[A-Z]$/);
  49 }
  50 sub getBase36($) {
  51         my ($char) = @_;
  52         if(isAlpha($char)) {
  53                 return (ord($char) - ORD_A);
  54         } else {
  55                 return int($char) + 26;
  56         }
  57 }
  58 sub decodeSID(@) {
  59         my ($a, $b, $c) = @_;
  60         if(length($a) > 1) {
  61                 ($a, $b, $c) = split(//, $a);
  62         }
  63         my $sidN = 0;
  64         foreach my $char ($a,$b,$c) {
  65                 $sidN <<= 6;
  66                 $sidN |= getBase36($char);
  67         }
  68         return $sidN;
  69 }
  70 sub decodeUUID($) {
  71         my ($UUID) = @_;
  72         my @chars = split(//, $UUID);
  73         #my @sidC = @chars[0..2];
  74         #my @uidC = @chars[3..8];
  75         my $sidN = decodeSID(@chars[0..2]);
  76         my $uidN = 0;
  77         foreach my $char (@chars[3..8]) {
  78                 $uidN <<= 6;
  79                 $uidN |= getBase36($char);
  80         }
  81         return (($sidN << UID_BITS) | $uidN);
  82 }
  83
  84 sub encodeChar($) {
  85         my ($ch) = @_;
  86         if($ch < 26) {
  87                 $ch = chr(($ch) + ORD_A);
  88         } else {
  89                 $ch -= 26;
  90         }
  91 }
  92 sub int2chars($$) {
  93         my ($id_int, $list) = @_;
  94         foreach my $ch (reverse @$list) {
  95                 $ch = $id_int & CHAR_MASK;
  96                 $id_int >>= CHAR_BITS;
  97                 $ch = encodeChar($ch);
  98         }
  99 }
 100 sub encodeUUID($) {
 101         my ($int) = @_;
 102         my $SID_int = ($int & (SID_BITMASK)) >> UID_BITS;
 103         my $UID_int = $int & UID_BITMASK;
 104         my @SID = (0,0,0);
 105         int2chars($SID_int, \@SID);
 106         my @UID = (0,0,0,0,0,0);
 107         int2chars($UID_int, \@UID);
 108         print join('', @SID,@UID),"\n";
 109 }
 110
 111 1;
 112
 113 #=cut
 114 #my $int = decodeUUID('751AAAAAA');
 115 #print "$int\n";
 116 #print log($int)/log(2), "\n";
 117 #encodeUUID($int);
 118 print decodeUUID('583AAAAAK');
 119 #print encodeUUID (1);
 120 #=cut