modules/GUID.pm

   1 package GUID;
   2
   3 # ************************************************************
   4 # Description   : Generate GUID's for VC7 projects and workspaces
   5 # Author        : Chad Elliott
   6 # Create Date   : 5/14/2002
   7 # ************************************************************
   8
   9 # ************************************************************
  10 # Pragmas
  11 # ************************************************************
  12
  13 use strict;
  14
  15 # ************************************************************
  16 # Subroutine Section
  17 # ************************************************************
  18
  19 sub generate {
  20   my($out, $in, $cwd) = @_;
  21   my $chash = GUID::hash($cwd);
  22   my $nhash = GUID::hash($out);
  23   my $ihash = GUID::hash($in);
  24   my $val   = 0xfeca1bad;
  25
  26   return sprintf("%08X-%04X-%04X-%04X-%04X%08X",
  27                  $nhash & 0xffffffff, ($val >> 16) & 0xffff,
  28                  ($val & 0xffff), ($ihash >> 16) & 0xffff,
  29                  $ihash & 0xffff, $chash & 0xffffffff);
  30 }
  31
  32
  33 sub hash {
  34   my $str   = shift;
  35   my $value = 0;
  36
  37   if (defined $str) {
  38     my $length = length($str);
  39     for(my $i = 0; $i < $length; $i++) {
  40       $value = (($value << 4) & 0xffffffff) ^ ($value >> 28)
  41         ^ ord(substr($str, $i, 1));
  42     }
  43   }
  44
  45   return $value;
  46 }
  47
  48 1;