Subversion Repositories gelsvn

Rev

Rev 198 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 198 Rev 217
Line 9... Line 9...
9 
# ************************************************************
 9 
# ************************************************************
10 
# Pragmas
 10 
# Pragmas
11 
# ************************************************************
 11 
# ************************************************************
12 
 
 12 
 
13 
use strict;
 13 
use strict;
- 
 
 14 
use File::Spec;
14 
use File::Basename;
 15 
use File::Basename;
15 
 
 16 
 
16 
if ($^O eq 'VMS') {
 - 
 
17 
  require VMS::Filespec;
 - 
 
18 
  import VMS::Filespec qw(unixify);
 - 
 
19 
}
 - 
 
20 
 
 - 
 
21 
# ************************************************************
 17 
# ************************************************************
22 
# Data Section
 18 
# Data Section
23 
# ************************************************************
 19 
# ************************************************************
24 
 
 20 
 
- 
 
 21 
my($onVMS) = ($^O eq 'VMS');
- 
 
 22 
my($case_insensitive) = File::Spec->case_tolerant();
25 
my($cwd) = Cwd::getcwd();
 23 
my($cwd) = Cwd::getcwd();
26 
if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
 24 
if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
27 
  my($cyg) = `cygpath -w $cwd`;
 25 
  my($cyg) = `cygpath -w $cwd`;
28 
  if (defined $cyg) {
 26 
  if (defined $cyg) {
29 
    $cyg =~ s/\\/\//g;
 27 
    $cyg =~ s/\\/\//g;
30 
    chop($cwd = $cyg);
 28 
    chop($cwd = $cyg);
31 
  }
 29 
  }
- 
 
 30 
  $case_insensitive = 1;
32 
}
 31 
}
33 
elsif ($^O eq 'VMS') {
 32 
elsif ($onVMS) {
34 
  $cwd = unixify($cwd);
 33 
  $cwd = VMS::Filespec::unixify($cwd);
- 
 
 34 
  $cwd =~ s!/$!!g;
35 
}
 35 
}
36 
my($start) = $cwd;
 36 
my($start) = $cwd;
37 
 
 37 
 
38 
# ************************************************************
 38 
# ************************************************************
39 
# Subroutine Section
 39 
# Subroutine Section
Line 50... Line 50...
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 ($dir =~ /\.\./) {
 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 ($^O eq 'VMS') {
 64 
      elsif ($onVMS) {
65 
        $cwd = unixify($cwd);
 65 
        $cwd = VMS::Filespec::unixify($cwd);
- 
 
 66 
        $cwd =~ s!/$!!g;
66 
      }
 67 
      }
67 
    }
 68 
    }
68 
    else {
 69 
    else {
69 
      if ($dir =~ /^(\/|[a-z]:)/i) {
 70 
      if ($dir =~ /^(\/|[a-z]:)/i) {
70 
        $cwd = $dir;
 71 
        $cwd = $dir;
Line 87... Line 88...
87 
sub getstartdir {
 88 
sub getstartdir {
88 
  #my($self) = shift;
 89 
  #my($self) = shift;
89 
  return $start;
 90 
  return $start;
90 
}
 91 
}
91 
 
 92 
 
- 
 
 93 
 
- 
 
 94 
sub mpc_basename {
- 
 
 95 
  #my($self) = $_[0];
- 
 
 96 
  my($file) = $_[1];
- 
 
 97 
  $file =~ s!.*/!!;
- 
 
 98 
  return $file;
- 
 
 99 
}
- 
 
 100 
 
- 
 
 101 
 
92 
sub mpc_dirname {
 102 
sub mpc_dirname {
93 
  my($self) = shift;
 103 
  my($self) = shift;
94 
  my($dir)  = shift;
 104 
  my($dir)  = shift;
95 
 
 105 
 
96 
  if ($^O eq 'VMS') {
 106 
  if ($onVMS) {
97 
    if ($dir =~ /\//) {
 107 
    if (index($dir, '/') >= 0) {
98 
      return unixify(dirname($dir));
 108 
      $dir = VMS::Filespec::unixify(dirname($dir));
- 
 
 109 
      $dir =~ s!/$!!g;
- 
 
 110 
      return $dir;
99 
    }
 111 
    }
100 
    else {
 112 
    else {
101 
      return '.';
 113 
      return '.';
102 
    }
 114 
    }
103 
  }
 115 
  }
Line 113... Line 125...
113 
  my(@files)   = ();
 125 
  my(@files)   = ();
114 
 
 126 
 
115 
  ## glob() provided by OpenVMS does not understand [] within
 127 
  ## glob() provided by OpenVMS does not understand [] within
116 
  ## the pattern.  So, we implement our own through recursive calls
 128 
  ## the pattern.  So, we implement our own through recursive calls
117 
  ## to mpc_glob().
 129 
  ## to mpc_glob().
118 
  if ($^O eq 'VMS' && $pattern =~ /(.*)\[([^\]]+)\](.*)/) {
 130 
  if ($onVMS && $pattern =~ /(.*)\[([^\]]+)\](.*)/) {
119 
    my($pre)  = $1;
 131 
    my($pre)  = $1;
120 
    my($mid)  = $2;
 132 
    my($mid)  = $2;
121 
    my($post) = $3;
 133 
    my($post) = $3;
122 
    for(my $i = 0; $i < length($mid); $i++) {
 134 
    for(my $i = 0; $i < length($mid); $i++) {
123 
      my($p) = $pre . substr($mid, $i, 1) . $post;
 135 
      my($p) = $pre . substr($mid, $i, 1) . $post;
124 
      my(@new) = $self->mpc_glob($p);
 - 
 
125 
      foreach my $new ($self->mpc_glob($p)) {
 136 
      foreach my $new (DirectoryManager::mpc_glob($self, $p)) {
126 
        my($found) = undef;
 137 
        my($found) = undef;
127 
        foreach my $file (@files) {
 138 
        foreach my $file (@files) {
128 
          if ($file eq $new) {
 139 
          if ($file eq $new) {
129 
            $found = 1;
 140 
            $found = 1;
130 
            last;
 141 
            last;
Line 145... Line 156...
145 
 
 156 
 
146 
# ************************************************************
 157 
# ************************************************************
147 
# Virtual Methods To Be Overridden
 158 
# Virtual Methods To Be Overridden
148 
# ************************************************************
 159 
# ************************************************************
149 
 
 160 
 
- 
 
 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 
 
150 
sub convert_slashes {
 187 
sub convert_slashes {
151 
  #my($self) = shift;
 188 
  #my($self) = shift;
152 
  return 1;
 189 
  return 0;
153 
}
 190 
}
154 
 
 191 
 
- 
 
 192 
sub case_insensitive {
- 
 
 193 
  #my($self) = shift;
- 
 
 194 
  return $case_insensitive;
- 
 
 195 
}
155 
 
 196 
 
156 
1;
 197 
1;