Subversion Repositories gelsvn

Rev

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

Rev 107 Rev 198
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::Basename;
 14 
use File::Basename;
15 
 
 15 
 
16 
if ($^O eq 'VMS') {
 16 
if ($^O eq 'VMS') {
17 
  require VMS::Filespec;
 17 
  require VMS::Filespec;
18 
  import VMS::Filespec qw(unixify);
 18 
  import VMS::Filespec qw(unixify);
19 
}
 19 
}
20 
 
 20 
 
21 
# ************************************************************
 21 
# ************************************************************
22 
# Data Section
 22 
# Data Section
23 
# ************************************************************
 23 
# ************************************************************
24 
 
 24 
 
25 
my($cwd) = Cwd::getcwd();
 25 
my($cwd) = Cwd::getcwd();
26 
if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
 26 
if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
27 
  my($cyg) = `cygpath -w $cwd`;
 27 
  my($cyg) = `cygpath -w $cwd`;
28 
  if (defined $cyg) {
 28 
  if (defined $cyg) {
29 
    $cyg =~ s/\\/\//g;
 29 
    $cyg =~ s/\\/\//g;
30 
    chop($cwd = $cyg);
 30 
    chop($cwd = $cyg);
31 
  }
 31 
  }
32 
}
 32 
}
- 
 
 33 
elsif ($^O eq 'VMS') {
- 
 
 34 
  $cwd = unixify($cwd);
- 
 
 35 
}
33 
my($start) = $cwd;
 36 
my($start) = $cwd;
34 
 
 37 
 
35 
# ************************************************************
 38 
# ************************************************************
36 
# Subroutine Section
 39 
# Subroutine Section
37 
# ************************************************************
 40 
# ************************************************************
38 
 
 41 
 
39 
sub cd {
 42 
sub cd {
40 
  my($self)   = shift;
 43 
  my($self)   = shift;
41 
  my($dir)    = shift;
 44 
  my($dir)    = shift;
42 
  my($status) = chdir($dir);
 45 
  my($status) = chdir($dir);
43 
 
 46 
 
44 
  if ($status && $dir ne '.') {
 47 
  if ($status && $dir ne '.') {
45 
    ## First strip out any /./ or ./ or /.
 48 
    ## First strip out any /./ or ./ or /.
46 
    $dir =~ s/\/\.\//\//g;
 49 
    $dir =~ s/\/\.\//\//g;
47 
    $dir =~ s/^\.\///;
 50 
    $dir =~ s/^\.\///;
48 
    $dir =~ s/\/\.$//;
 51 
    $dir =~ s/\/\.$//;
49 
 
 52 
 
50 
    ## If the new directory contains a relative directory
 53 
    ## If the new directory contains a relative directory
51 
    ## then we just get the real working directory
 54 
    ## then we just get the real working directory
52 
    if ($dir =~ /\.\./) {
 55 
    if ($dir =~ /\.\./) {
53 
      $cwd = Cwd::getcwd();
 56 
      $cwd = Cwd::getcwd();
54 
      if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
 57 
      if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
55 
         my($cyg) = `cygpath -w $cwd`;
 58 
        my($cyg) = `cygpath -w $cwd`;
56 
         if (defined $cyg) {
 59 
        if (defined $cyg) {
57 
           $cyg =~ s/\\/\//g;
 60 
          $cyg =~ s/\\/\//g;
58 
           chop($cwd = $cyg);
 61 
          chop($cwd = $cyg);
59 
         }
 62 
        }
- 
 
 63 
      }
- 
 
 64 
      elsif ($^O eq 'VMS') {
- 
 
 65 
        $cwd = unixify($cwd);
60 
       }
 66 
      }
61 
    }
 67 
    }
62 
    else {
 68 
    else {
63 
      if ($dir =~ /^(\/|[a-z]:)/i) {
 69 
      if ($dir =~ /^(\/|[a-z]:)/i) {
64 
        $cwd = $dir;
 70 
        $cwd = $dir;
65 
      }
 71 
      }
66 
      else {
 72 
      else {
67 
        $cwd .= "/$dir";
 73 
        $cwd .= "/$dir";
68 
      }
 74 
      }
69 
    }
 75 
    }
70 
  }
 76 
  }
71 
  return $status;
 77 
  return $status;
72 
}
 78 
}
73 
 
 79 
 
74 
 
 80 
 
75 
sub getcwd {
 81 
sub getcwd {
76 
  #my($self) = shift;
 82 
  #my($self) = shift;
77 
  return $cwd;
 83 
  return $cwd;
78 
}
 84 
}
79 
 
 85 
 
80 
 
 86 
 
81 
sub getstartdir {
 87 
sub getstartdir {
82 
  #my($self) = shift;
 88 
  #my($self) = shift;
83 
  return $start;
 89 
  return $start;
84 
}
 90 
}
85 
 
 91 
 
86 
sub mpc_dirname {
 92 
sub mpc_dirname {
87 
  my($self) = shift;
 93 
  my($self) = shift;
88 
  my($dir)  = shift;
 94 
  my($dir)  = shift;
- 
 
 95 
 
89 
  return ($^O ne 'VMS' ? File::Basename::dirname($dir) :
 96 
  if ($^O eq 'VMS') {
- 
 
 97 
    if ($dir =~ /\//) {
90 
                         unixify(File::Basename::dirname($dir)));
 98 
      return unixify(dirname($dir));
- 
 
 99 
    }
- 
 
 100 
    else {
- 
 
 101 
      return '.';
- 
 
 102 
    }
- 
 
 103 
  }
- 
 
 104 
  else {
- 
 
 105 
    return dirname($dir);
- 
 
 106 
  }
91 
}
 107 
}
92 
 
 108 
 
93 
 
 109 
 
- 
 
 110 
sub mpc_glob {
- 
 
 111 
  my($self)    = shift;
- 
 
 112 
  my($pattern) = shift;
- 
 
 113 
  my(@files)   = ();
- 
 
 114 
 
- 
 
 115 
  ## glob() provided by OpenVMS does not understand [] within
- 
 
 116 
  ## the pattern.  So, we implement our own through recursive calls
- 
 
 117 
  ## to mpc_glob().
- 
 
 118 
  if ($^O eq 'VMS' && $pattern =~ /(.*)\[([^\]]+)\](.*)/) {
- 
 
 119 
    my($pre)  = $1;
- 
 
 120 
    my($mid)  = $2;
- 
 
 121 
    my($post) = $3;
- 
 
 122 
    for(my $i = 0; $i < length($mid); $i++) {
- 
 
 123 
      my($p) = $pre . substr($mid, $i, 1) . $post;
- 
 
 124 
      my(@new) = $self->mpc_glob($p);
- 
 
 125 
      foreach my $new ($self->mpc_glob($p)) {
- 
 
 126 
        my($found) = undef;
- 
 
 127 
        foreach my $file (@files) {
- 
 
 128 
          if ($file eq $new) {
- 
 
 129 
            $found = 1;
- 
 
 130 
            last;
- 
 
 131 
          }
- 
 
 132 
        }
- 
 
 133 
        if (!$found) {
- 
 
 134 
          push(@files, $new);
- 
 
 135 
        }
- 
 
 136 
      }
- 
 
 137 
    }
- 
 
 138 
  }
- 
 
 139 
  else {
- 
 
 140 
    push(@files, glob($pattern));
- 
 
 141 
  }
- 
 
 142 
 
- 
 
 143 
  return @files;
- 
 
 144 
}
- 
 
 145 
 
94 
# ************************************************************
 146 
# ************************************************************
95 
# Virtual Methods To Be Overridden
 147 
# Virtual Methods To Be Overridden
96 
# ************************************************************
 148 
# ************************************************************
97 
 
 149 
 
98 
sub convert_slashes {
 150 
sub convert_slashes {
99 
  #my($self) = shift;
 151 
  #my($self) = shift;
100 
  return 1;
 152 
  return 1;
101 
}
 153 
}
102 
 
 154 
 
103 
 
 155 
 
104 
1;
 156 
1;
105 
 
 157