Subversion Repositories gelsvn

Rev

Go to most recent revision | 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 
}
33 
my($start) = $cwd;
34 
 
35 
# ************************************************************
36 
# Subroutine Section
37 
# ************************************************************
38 
 
39 
sub cd {
40 
  my($self)   = shift;
41 
  my($dir)    = shift;
42 
  my($status) = chdir($dir);
43 
 
44 
  if ($status && $dir ne '.') {
45 
    ## First strip out any /./ or ./ or /.
46 
    $dir =~ s/\/\.\//\//g;
47 
    $dir =~ s/^\.\///;
48 
    $dir =~ s/\/\.$//;
49 
 
50 
    ## If the new directory contains a relative directory
51 
    ## then we just get the real working directory
52 
    if ($dir =~ /\.\./) {
53 
      $cwd = Cwd::getcwd();
54 
      if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
55 
         my($cyg) = `cygpath -w $cwd`;
56 
         if (defined $cyg) {
57 
           $cyg =~ s/\\/\//g;
58 
           chop($cwd = $cyg);
59 
         }
60 
       }
61 
    }
62 
    else {
63 
      if ($dir =~ /^(\/|[a-z]:)/i) {
64 
        $cwd = $dir;
65 
      }
66 
      else {
67 
        $cwd .= "/$dir";
68 
      }
69 
    }
70 
  }
71 
  return $status;
72 
}
73 
 
74 
 
75 
sub getcwd {
76 
  #my($self) = shift;
77 
  return $cwd;
78 
}
79 
 
80 
 
81 
sub getstartdir {
82 
  #my($self) = shift;
83 
  return $start;
84 
}
85 
 
86 
sub mpc_dirname {
87 
  my($self) = shift;
88 
  my($dir)  = shift;
89 
  return ($^O ne 'VMS' ? File::Basename::dirname($dir) :
90 
                         unixify(File::Basename::dirname($dir)));
91 
}
92 
 
93 
 
94 
# ************************************************************
95 
# Virtual Methods To Be Overridden
96 
# ************************************************************
97 
 
98 
sub convert_slashes {
99 
  #my($self) = shift;
100 
  return 1;
101 
}
102 
 
103 
 
104 
1;