Subversion Repositories gelsvn

Rev

Rev 198 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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