Subversion Repositories gelsvn

Rev

Details | 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;
14 
use File::Basename;
15 
 
16 
if ($^O eq 'VMS') {
17 
  require VMS::Filespec;
18 
  import VMS::Filespec qw(unixify);
19 
}
20 
 
21 
# ************************************************************
22 
# Data Section
23 
# ************************************************************
24 
 
25 
my($cwd) = Cwd::getcwd();
26 
if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
27 
  my($cyg) = `cygpath -w $cwd`;
28 
  if (defined $cyg) {
29 
    $cyg =~ s/\\/\//g;
30 
    chop($cwd = $cyg);
31 
  }
32 
}
198 bj 33 
elsif ($^O eq 'VMS') {
34 
  $cwd = unixify($cwd);
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
55 
    if ($dir =~ /\.\./) {
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 
      }
64 
      elsif ($^O eq 'VMS') {
65 
        $cwd = unixify($cwd);
66 
      }
107 bj 67 
    }
68 
    else {
69 
      if ($dir =~ /^(\/|[a-z]:)/i) {
70 
        $cwd = $dir;
71 
      }
72 
      else {
73 
        $cwd .= "/$dir";
74 
      }
75 
    }
76 
  }
77 
  return $status;
78 
}
79 
 
80 
 
81 
sub getcwd {
82 
  #my($self) = shift;
83 
  return $cwd;
84 
}
85 
 
86 
 
87 
sub getstartdir {
88 
  #my($self) = shift;
89 
  return $start;
90 
}
91 
 
92 
sub mpc_dirname {
93 
  my($self) = shift;
94 
  my($dir)  = shift;
198 bj 95 
 
96 
  if ($^O eq 'VMS') {
97 
    if ($dir =~ /\//) {
98 
      return unixify(dirname($dir));
99 
    }
100 
    else {
101 
      return '.';
102 
    }
103 
  }
104 
  else {
105 
    return dirname($dir);
106 
  }
107 bj 107 
}
108 
 
109 
 
198 bj 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 
 
107 bj 146 
# ************************************************************
147 
# Virtual Methods To Be Overridden
148 
# ************************************************************
149 
 
150 
sub convert_slashes {
151 
  #my($self) = shift;
152 
  return 1;
153 
}
154 
 
155 
 
156 
1;