Subversion Repositories gelsvn

Rev

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

Rev 217 Rev 259
1 
package DirectoryManager;
 1 
package DirectoryManager;
2 
 
 2 
 
3 
# ************************************************************
 3 
# ************************************************************
4 
# Description   : This module provides directory related methods
 4 
# Description   : This module provides directory related methods
5 
# Author        : Chad Elliott
 5 
# Author        : Chad Elliott
6 
# Create Date   : 5/13/2004
 6 
# Create Date   : 5/13/2004
7 
# ************************************************************
 7 
# ************************************************************
8 
 
 8 
 
9 
# ************************************************************
 9 
# ************************************************************
10 
# Pragmas
 10 
# Pragmas
11 
# ************************************************************
 11 
# ************************************************************
12 
 
 12 
 
13 
use strict;
 13 
use strict;
14 
use File::Spec;
 14 
use File::Spec;
15 
use File::Basename;
 15 
use File::Basename;
16 
 
 16 
 
17 
# ************************************************************
 17 
# ************************************************************
18 
# Data Section
 18 
# Data Section
19 
# ************************************************************
 19 
# ************************************************************
20 
 
 20 
 
21 
my($onVMS) = ($^O eq 'VMS');
 21 
my($onVMS) = ($^O eq 'VMS');
22 
my($case_insensitive) = File::Spec->case_tolerant();
 22 
my($case_insensitive) = File::Spec->case_tolerant();
23 
my($cwd) = Cwd::getcwd();
 23 
my($cwd) = Cwd::getcwd();
24 
if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
 24 
if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
25 
  my($cyg) = `cygpath -w $cwd`;
 25 
  my($cyg) = `cygpath -w $cwd`;
26 
  if (defined $cyg) {
 26 
  if (defined $cyg) {
27 
    $cyg =~ s/\\/\//g;
 27 
    $cyg =~ s/\\/\//g;
28 
    chop($cwd = $cyg);
 28 
    chop($cwd = $cyg);
29 
  }
 29 
  }
30 
  $case_insensitive = 1;
 30 
  $case_insensitive = 1;
31 
}
 31 
}
32 
elsif ($onVMS) {
 32 
elsif ($onVMS) {
33 
  $cwd = VMS::Filespec::unixify($cwd);
 33 
  $cwd = VMS::Filespec::unixify($cwd);
34 
  $cwd =~ s!/$!!g;
 34 
  $cwd =~ s!/$!!g;
35 
}
 35 
}
36 
my($start) = $cwd;
 36 
my($start) = $cwd;
37 
 
 37 
 
38 
# ************************************************************
 38 
# ************************************************************
39 
# Subroutine Section
 39 
# Subroutine Section
40 
# ************************************************************
 40 
# ************************************************************
41 
 
 41 
 
42 
sub cd {
 42 
sub cd {
43 
  my($self)   = shift;
 43 
  my($self)   = shift;
44 
  my($dir)    = shift;
 44 
  my($dir)    = shift;
45 
  my($status) = chdir($dir);
 45 
  my($status) = chdir($dir);
46 
 
 46 
 
47 
  if ($status && $dir ne '.') {
 47 
  if ($status && $dir ne '.') {
48 
    ## First strip out any /./ or ./ or /.
 48 
    ## First strip out any /./ or ./ or /.
49 
    $dir =~ s/\/\.\//\//g;
 49 
    $dir =~ s/\/\.\//\//g;
50 
    $dir =~ s/^\.\///;
 50 
    $dir =~ s/^\.\///;
51 
    $dir =~ s/\/\.$//;
 51 
    $dir =~ s/\/\.$//;
52 
 
 52 
 
53 
    ## If the new directory contains a relative directory
 53 
    ## If the new directory contains a relative directory
54 
    ## then we just get the real working directory
 54 
    ## then we just get the real working directory
55 
    if (index($dir, '..') >= 0) {
 55 
    if (index($dir, '..') >= 0) {
56 
      $cwd = Cwd::getcwd();
 56 
      $cwd = Cwd::getcwd();
57 
      if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
 57 
      if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
58 
        my($cyg) = `cygpath -w $cwd`;
 58 
        my($cyg) = `cygpath -w $cwd`;
59 
        if (defined $cyg) {
 59 
        if (defined $cyg) {
60 
          $cyg =~ s/\\/\//g;
 60 
          $cyg =~ s/\\/\//g;
61 
          chop($cwd = $cyg);
 61 
          chop($cwd = $cyg);
62 
        }
 62 
        }
63 
      }
 63 
      }
64 
      elsif ($onVMS) {
 64 
      elsif ($onVMS) {
65 
        $cwd = VMS::Filespec::unixify($cwd);
 65 
        $cwd = VMS::Filespec::unixify($cwd);
66 
        $cwd =~ s!/$!!g;
 66 
        $cwd =~ s!/$!!g;
67 
      }
 67 
      }
68 
    }
 68 
    }
69 
    else {
 69 
    else {
70 
      if ($dir =~ /^(\/|[a-z]:)/i) {
 70 
      if ($dir =~ /^(\/|[a-z]:)/i) {
71 
        $cwd = $dir;
 71 
        $cwd = $dir;
72 
      }
 72 
      }
73 
      else {
 73 
      else {
74 
        $cwd .= "/$dir";
 74 
        $cwd .= "/$dir";
75 
      }
 75 
      }
76 
    }
 76 
    }
77 
  }
 77 
  }
78 
  return $status;
 78 
  return $status;
79 
}
 79 
}
80 
 
 80 
 
81 
 
 81 
 
82 
sub getcwd {
 82 
sub getcwd {
83 
  #my($self) = shift;
 83 
  #my($self) = shift;
84 
  return $cwd;
 84 
  return $cwd;
85 
}
 85 
}
86 
 
 86 
 
87 
 
 87 
 
88 
sub getstartdir {
 88 
sub getstartdir {
89 
  #my($self) = shift;
 89 
  #my($self) = shift;
90 
  return $start;
 90 
  return $start;
91 
}
 91 
}
92 
 
 92 
 
93 
 
 93 
 
94 
sub mpc_basename {
 94 
sub mpc_basename {
95 
  #my($self) = $_[0];
 95 
  #my($self) = $_[0];
96 
  my($file) = $_[1];
 96 
  my($file) = $_[1];
97 
  $file =~ s!.*/!!;
 97 
  $file =~ s!.*/!!;
98 
  return $file;
 98 
  return $file;
99 
}
 99 
}
100 
 
 100 
 
101 
 
 101 
 
102 
sub mpc_dirname {
 102 
sub mpc_dirname {
103 
  my($self) = shift;
 103 
  my($self) = shift;
104 
  my($dir)  = shift;
 104 
  my($dir)  = shift;
105 
 
 105 
 
106 
  if ($onVMS) {
 106 
  if ($onVMS) {
107 
    if (index($dir, '/') >= 0) {
 107 
    if (index($dir, '/') >= 0) {
108 
      $dir = VMS::Filespec::unixify(dirname($dir));
 108 
      $dir = VMS::Filespec::unixify(dirname($dir));
109 
      $dir =~ s!/$!!g;
 109 
      $dir =~ s!/$!!g;
110 
      return $dir;
 110 
      return $dir;
111 
    }
 111 
    }
112 
    else {
 112 
    else {
113 
      return '.';
 113 
      return '.';
114 
    }
 114 
    }
115 
  }
 115 
  }
116 
  else {
 116 
  else {
117 
    return dirname($dir);
 117 
    return dirname($dir);
118 
  }
 118 
  }
119 
}
 119 
}
120 
 
 120 
 
121 
 
 121 
 
122 
sub mpc_glob {
 122 
sub mpc_glob {
123 
  my($self)    = shift;
 123 
  my($self)    = shift;
124 
  my($pattern) = shift;
 124 
  my($pattern) = shift;
125 
  my(@files)   = ();
 125 
  my(@files)   = ();
126 
 
 126 
 
127 
  ## glob() provided by OpenVMS does not understand [] within
 127 
  ## glob() provided by OpenVMS does not understand [] within
128 
  ## the pattern.  So, we implement our own through recursive calls
 128 
  ## the pattern.  So, we implement our own through recursive calls
129 
  ## to mpc_glob().
 129 
  ## to mpc_glob().
130 
  if ($onVMS && $pattern =~ /(.*)\[([^\]]+)\](.*)/) {
 130 
  if ($onVMS && $pattern =~ /(.*)\[([^\]]+)\](.*)/) {
131 
    my($pre)  = $1;
 131 
    my($pre)  = $1;
132 
    my($mid)  = $2;
 132 
    my($mid)  = $2;
133 
    my($post) = $3;
 133 
    my($post) = $3;
134 
    for(my $i = 0; $i < length($mid); $i++) {
 134 
    for(my $i = 0; $i < length($mid); $i++) {
135 
      my($p) = $pre . substr($mid, $i, 1) . $post;
 135 
      my($p) = $pre . substr($mid, $i, 1) . $post;
136 
      foreach my $new (DirectoryManager::mpc_glob($self, $p)) {
 136 
      foreach my $new (DirectoryManager::mpc_glob($self, $p)) {
137 
        my($found) = undef;
 137 
        my($found) = undef;
138 
        foreach my $file (@files) {
 138 
        foreach my $file (@files) {
139 
          if ($file eq $new) {
 139 
          if ($file eq $new) {
140 
            $found = 1;
 140 
            $found = 1;
141 
            last;
 141 
            last;
142 
          }
 142 
          }
143 
        }
 143 
        }
144 
        if (!$found) {
 144 
        if (!$found) {
145 
          push(@files, $new);
 145 
          push(@files, $new);
146 
        }
 146 
        }
147 
      }
 147 
      }
148 
    }
 148 
    }
149 
  }
 149 
  }
150 
  else {
 150 
  else {
151 
    push(@files, glob($pattern));
 151 
    push(@files, glob($pattern));
152 
  }
 152 
  }
153 
 
 153 
 
154 
  return @files;
 154 
  return @files;
155 
}
 155 
}
156 
 
 156 
 
157 
# ************************************************************
 157 
# ************************************************************
158 
# Virtual Methods To Be Overridden
 158 
# Virtual Methods To Be Overridden
159 
# ************************************************************
 159 
# ************************************************************
160 
 
 160 
 
161 
sub translate_directory {
 161 
sub translate_directory {
162 
  my($self) = shift;
 162 
  my($self) = shift;
163 
  my($dir)  = shift;
 163 
  my($dir)  = shift;
164 
 
 164 
 
165 
  ## Remove the current working directory from $dir (if it is contained)
 165 
  ## Remove the current working directory from $dir (if it is contained)
166 
  my($cwd) = $self->getcwd();
 166 
  my($cwd) = $self->getcwd();
167 
  $cwd =~ s/\//\\/g if ($self->convert_slashes());
 167 
  $cwd =~ s/\//\\/g if ($self->convert_slashes());
168 
  if (index($dir, $cwd) == 0) {
 168 
  if (index($dir, $cwd) == 0) {
169 
    my($cwdl) = length($cwd);
 169 
    my($cwdl) = length($cwd);
170 
    return '.' if (length($dir) == $cwdl);
 170 
    return '.' if (length($dir) == $cwdl);
171 
    $dir = substr($dir, $cwdl + 1);
 171 
    $dir = substr($dir, $cwdl + 1);
172 
  }
 172 
  }
173 
 
 173 
 
174 
  ## Translate .. to $dd
 174 
  ## Translate .. to $dd
175 
  if (index($dir, '..') >= 0) {
 175 
  if (index($dir, '..') >= 0) {
176 
    my($dd) = 'dotdot';
 176 
    my($dd) = 'dotdot';
177 
    $dir =~ s/^\.\.([\/\\])/$dd$1/;
 177 
    $dir =~ s/^\.\.([\/\\])/$dd$1/;
178 
    $dir =~ s/([\/\\])\.\.$/$1$dd/;
 178 
    $dir =~ s/([\/\\])\.\.$/$1$dd/;
179 
    $dir =~ s/([\/\\])\.\.([\/\\])/$1$dd$2/g;
 179 
    $dir =~ s/([\/\\])\.\.([\/\\])/$1$dd$2/g;
180 
    $dir =~ s/^\.\.$/$dd/;
 180 
    $dir =~ s/^\.\.$/$dd/;
181 
  }
 181 
  }
182 
 
 182 
 
183 
  return $dir;
 183 
  return $dir;
184 
}
 184 
}
185 
 
 185 
 
186 
 
 186 
 
187 
sub convert_slashes {
 187 
sub convert_slashes {
188 
  #my($self) = shift;
 188 
  #my($self) = shift;
189 
  return 0;
 189 
  return 0;
190 
}
 190 
}
191 
 
 191 
 
192 
sub case_insensitive {
 192 
sub case_insensitive {
193 
  #my($self) = shift;
 193 
  #my($self) = shift;
194 
  return $case_insensitive;
 194 
  return $case_insensitive;
195 
}
 195 
}
196 
 
 196 
 
197 
1;
 197 
1;
198 
 
 198