WebSVN – gelsvn – Diff – /GELUtil/MPC/modules/WinProjectBase.pm


package WinProjectBase;
 
# ************************************************************
# Description   : A Windows base module for Project Creators
# Author        : Chad Elliott
# Create Date   : 1/4/2005
# ************************************************************
 
# ************************************************************
# Pragmas
# ************************************************************
 
use strict;
 
# ************************************************************
# Data Section
# ************************************************************
 
my($max_win_env) = 'MPC_MAX_WIN_FILE_LENGTH';
 
# ************************************************************
# Subroutine Section
# ************************************************************
 
sub convert_slashes {
  #my($self) = shift;
  return 1;
}
 
 
sub case_insensitive {
  #my($self) = shift;
  return 1;
}
 
 
sub translate_directory {
  my($self) = shift;
  my($dir)  = shift;
 
  ## Call the base class version
  $dir = $self->DirectoryManager::translate_directory($dir);
 
  ## Change drive letters and $() macros
  $dir =~ s/^([A-Z]):/$1/i;
  $dir =~ s/\$\(([^\)]+)\)/$1/g;
 
  ## We need to make sure that we do not exceed the maximum file name
  ## limitation (including the cwd (- c:\) and object file name).  So, we
  ## check the total length against a predetermined "acceptable" value.
  ## This acceptable value is modifiable through the environment.
  my($maxenv) = $ENV{$max_win_env};
  my($maxlen) = (defined $maxenv && $maxenv =~ /^\d+$/ ? $maxenv : 128) + 3;
  my($dirlen) = length($dir);
  my($diff)   = (length($self->getcwd()) + $dirlen + 1) - $maxlen;
 
  if ($diff > 0) {
    if ($diff > $dirlen) {
      $dir = substr($dir, $dirlen - 1);
    }
    else {
      $dir = substr($dir, $diff);
    }
    while($dir =~ s/^\\//) {
    }
  }
 
  return $dir;
}
 
 
sub validated_directory {
  my($self) = shift;
  my($dir)  = shift;
 
  ## $(...) could contain a drive letter and Windows can not
  ## make a directory that resembles a drive letter.  So, we have
  ## to exclude those directories with $(...).
  if ($dir =~ /\$\([^\)]+\)/ || $dir =~ /\.\.\\/ || $dir =~ /^[A-Z]:/i) {
    return '.';
  }
  else {
    return $dir;
  }
}
 
 
sub crlf {
  my($self) = shift;
  return $self->windows_crlf();
}
 
 
sub file_sorter {
  #my($self)  = shift;
  #my($left)  = shift;
  #my($right) = shift;
  return lc($_[1]) cmp lc($_[2]);
}
 
 
1;
 

Rev 217	Rev 259
1	`package WinProjectBase;`	1	`package WinProjectBase;`
2		2
3	`# ************************************************************`	3	`# ************************************************************`
4	`# Description : A Windows base module for Project Creators`	4	`# Description : A Windows base module for Project Creators`
5	`# Author : Chad Elliott`	5	`# Author : Chad Elliott`
6	`# Create Date : 1/4/2005`	6	`# Create Date : 1/4/2005`
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	`# Data Section`	16	`# Data Section`
17	`# ************************************************************`	17	`# ************************************************************`
18		18
19	`my($max_win_env) = 'MPC_MAX_WIN_FILE_LENGTH';`	19	`my($max_win_env) = 'MPC_MAX_WIN_FILE_LENGTH';`
20		20
21	`# ************************************************************`	21	`# ************************************************************`
22	`# Subroutine Section`	22	`# Subroutine Section`
23	`# ************************************************************`	23	`# ************************************************************`
24		24
25	`sub convert_slashes {`	25	`sub convert_slashes {`
26	`#my($self) = shift;`	26	`#my($self) = shift;`
27	`return 1;`	27	`return 1;`
28	`}`	28	`}`
29		29
30		30
31	`sub case_insensitive {`	31	`sub case_insensitive {`
32	`#my($self) = shift;`	32	`#my($self) = shift;`
33	`return 1;`	33	`return 1;`
34	`}`	34	`}`
35		35
36		36
37	`sub translate_directory {`	37	`sub translate_directory {`
38	`my($self) = shift;`	38	`my($self) = shift;`
39	`my($dir) = shift;`	39	`my($dir) = shift;`
40		40
41	`## Call the base class version`	41	`## Call the base class version`
42	`$dir = $self->DirectoryManager::translate_directory($dir);`	42	`$dir = $self->DirectoryManager::translate_directory($dir);`
43		43
44	`## Change drive letters and $() macros`	44	`## Change drive letters and $() macros`
45	`$dir =~ s/^([A-Z]):/$1/i;`	45	`$dir =~ s/^([A-Z]):/$1/i;`
46	`$dir =~ s/\$\(([^\)]+)\)/$1/g;`	46	`$dir =~ s/\$\(([^\)]+)\)/$1/g;`
47		47
48	`## We need to make sure that we do not exceed the maximum file name`	48	`## We need to make sure that we do not exceed the maximum file name`
49	`## limitation (including the cwd (- c:\) and object file name). So, we`	49	`## limitation (including the cwd (- c:\) and object file name). So, we`
50	`## check the total length against a predetermined "acceptable" value.`	50	`## check the total length against a predetermined "acceptable" value.`
51	`## This acceptable value is modifiable through the environment.`	51	`## This acceptable value is modifiable through the environment.`
52	`my($maxenv) = $ENV{$max_win_env};`	52	`my($maxenv) = $ENV{$max_win_env};`
53	`my($maxlen) = (defined $maxenv && $maxenv =~ /^\d+$/ ? $maxenv : 128) + 3;`	53	`my($maxlen) = (defined $maxenv && $maxenv =~ /^\d+$/ ? $maxenv : 128) + 3;`
54	`my($dirlen) = length($dir);`	54	`my($dirlen) = length($dir);`
55	`my($diff) = (length($self->getcwd()) + $dirlen + 1) - $maxlen;`	55	`my($diff) = (length($self->getcwd()) + $dirlen + 1) - $maxlen;`
56		56
57	`if ($diff > 0) {`	57	`if ($diff > 0) {`
58	`if ($diff > $dirlen) {`	58	`if ($diff > $dirlen) {`
59	`$dir = substr($dir, $dirlen - 1);`	59	`$dir = substr($dir, $dirlen - 1);`
60	`}`	60	`}`
61	`else {`	61	`else {`
62	`$dir = substr($dir, $diff);`	62	`$dir = substr($dir, $diff);`
63	`}`	63	`}`
64	`while($dir =~ s/^\\//) {`	64	`while($dir =~ s/^\\//) {`
65	`}`	65	`}`
66	`}`	66	`}`
67		67
68	`return $dir;`	68	`return $dir;`
69	`}`	69	`}`
70		70
71		71
72	`sub validated_directory {`	72	`sub validated_directory {`
73	`my($self) = shift;`	73	`my($self) = shift;`
74	`my($dir) = shift;`	74	`my($dir) = shift;`
75		75
76	`## $(...) could contain a drive letter and Windows can not`	76	`## $(...) could contain a drive letter and Windows can not`
77	`## make a directory that resembles a drive letter. So, we have`	77	`## make a directory that resembles a drive letter. So, we have`
78	`## to exclude those directories with $(...).`	78	`## to exclude those directories with $(...).`
79	`if ($dir =~ /\$\([^\)]+\)/ \|\| $dir =~ /\.\.\\/ \|\| $dir =~ /^[A-Z]:/i) {`	79	`if ($dir =~ /\$\([^\)]+\)/ \|\| $dir =~ /\.\.\\/ \|\| $dir =~ /^[A-Z]:/i) {`
80	`return '.';`	80	`return '.';`
81	`}`	81	`}`
82	`else {`	82	`else {`
83	`return $dir;`	83	`return $dir;`
84	`}`	84	`}`
85	`}`	85	`}`
86		86
87		87
88	`sub crlf {`	88	`sub crlf {`
89	`my($self) = shift;`	89	`my($self) = shift;`
90	`return $self->windows_crlf();`	90	`return $self->windows_crlf();`
91	`}`	91	`}`
92		92
93		93
94	`sub file_sorter {`	94	`sub file_sorter {`
95	`#my($self) = shift;`	95	`#my($self) = shift;`
96	`#my($left) = shift;`	96	`#my($left) = shift;`
97	`#my($right) = shift;`	97	`#my($right) = shift;`
98	`return lc($_[1]) cmp lc($_[2]);`	98	`return lc($_[1]) cmp lc($_[2]);`
99	`}`	99	`}`
100		100
101		101
102	`1;`	102	`1;`
103		103

Subversion Repositories gelsvn

(root)/GELUtil/MPC/modules/WinProjectBase.pm – Rev 217 → 259