Subversion Repositories gelsvn

Rev

Rev 107 | Only display areas with differences | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

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