Commit | Line | Data |
a0d0e21e |
1 | package Cwd; |
2 | require 5.000; |
3 | require Exporter; |
4 | |
5 | @ISA = qw(Exporter); |
6 | @EXPORT = qw(getcwd fastcwd); |
7 | @EXPORT_OK = qw(chdir); |
8 | |
9 | |
10 | # By Brandon S. Allbery |
11 | # |
12 | # Usage: $cwd = getcwd(); |
13 | |
14 | sub getcwd |
15 | { |
16 | my($dotdots, $cwd, @pst, @cst, $dir, @tst); |
17 | |
18 | unless (@cst = stat('.')) |
19 | { |
20 | warn "stat(.): $!"; |
21 | return ''; |
22 | } |
23 | $cwd = ''; |
24 | do |
25 | { |
26 | $dotdots .= '/' if $dotdots; |
27 | $dotdots .= '..'; |
28 | @pst = @cst; |
29 | unless (opendir(PARENT, $dotdots)) |
30 | { |
31 | warn "opendir($dotdots): $!"; |
32 | return ''; |
33 | } |
34 | unless (@cst = stat($dotdots)) |
35 | { |
36 | warn "stat($dotdots): $!"; |
37 | closedir(PARENT); |
38 | return ''; |
39 | } |
40 | if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) |
41 | { |
42 | $dir = ''; |
43 | } |
44 | else |
45 | { |
46 | do |
47 | { |
48 | unless ($dir = readdir(PARENT)) |
49 | { |
50 | warn "readdir($dotdots): $!"; |
51 | closedir(PARENT); |
52 | return ''; |
53 | } |
54 | unless (@tst = lstat("$dotdots/$dir")) |
55 | { |
56 | warn "lstat($dotdots/$dir): $!"; |
57 | closedir(PARENT); |
58 | return ''; |
59 | } |
60 | } |
61 | while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || |
62 | $tst[1] != $pst[1]); |
63 | } |
64 | $cwd = "$dir/$cwd"; |
65 | closedir(PARENT); |
66 | } while ($dir); |
67 | chop($cwd); |
68 | $cwd; |
69 | } |
70 | |
71 | |
72 | |
73 | # By John Bazik |
74 | # |
75 | # Usage: $cwd = &fastcwd; |
76 | # |
77 | # This is a faster version of getcwd. It's also more dangerous because |
78 | # you might chdir out of a directory that you can't chdir back into. |
79 | |
80 | sub fastcwd { |
81 | my($odev, $oino, $cdev, $cino, $tdev, $tino); |
82 | my(@path, $path); |
83 | local(*DIR); |
84 | |
85 | ($cdev, $cino) = stat('.'); |
86 | for (;;) { |
87 | ($odev, $oino) = ($cdev, $cino); |
88 | chdir('..'); |
89 | ($cdev, $cino) = stat('.'); |
90 | last if $odev == $cdev && $oino == $cino; |
91 | opendir(DIR, '.'); |
92 | for (;;) { |
93 | $_ = readdir(DIR); |
94 | next if $_ eq '.'; |
95 | next if $_ eq '..'; |
96 | |
97 | last unless $_; |
98 | ($tdev, $tino) = lstat($_); |
99 | last unless $tdev != $odev || $tino != $oino; |
100 | } |
101 | closedir(DIR); |
102 | unshift(@path, $_); |
103 | } |
104 | chdir($path = '/' . join('/', @path)); |
105 | $path; |
106 | } |
107 | |
108 | |
109 | # keeps track of current working directory in PWD environment var |
110 | # |
111 | # $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $ |
112 | # |
113 | # $Log: pwd.pl,v $ |
114 | # |
115 | # Usage: |
116 | # use Cwd 'chdir'; |
117 | # chdir $newdir; |
118 | |
119 | $chdir_init = 0; |
120 | |
121 | sub chdir_init{ |
122 | if ($ENV{'PWD'}) { |
123 | my($dd,$di) = stat('.'); |
124 | my($pd,$pi) = stat($ENV{'PWD'}); |
125 | if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { |
126 | chop($ENV{'PWD'} = `pwd`); |
127 | } |
128 | } |
129 | else { |
130 | chop($ENV{'PWD'} = `pwd`); |
131 | } |
132 | if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) { |
133 | my($pd,$pi) = stat($2); |
134 | my($dd,$di) = stat($1); |
135 | if (defined $pd and defined $dd and $di == $pi and $dd == $pd) { |
136 | $ENV{'PWD'}="$2$3"; |
137 | } |
138 | } |
139 | $chdir_init = 1; |
140 | } |
141 | |
142 | sub chdir { |
143 | my($newdir) = shift; |
144 | chdir_init() unless $chdir_init; |
145 | return 0 unless (CORE::chdir $newdir); |
146 | if ($newdir =~ m#^/#) { |
147 | $ENV{'PWD'} = $newdir; |
148 | }else{ |
149 | my(@curdir) = split(m#/#,$ENV{'PWD'}); |
150 | @curdir = '' unless @curdir; |
151 | foreach $component (split(m#/#, $newdir)) { |
152 | next if $component eq '.'; |
153 | pop(@curdir),next if $component eq '..'; |
154 | push(@curdir,$component); |
155 | } |
156 | $ENV{'PWD'} = join('/',@curdir) || '/'; |
157 | } |
158 | } |
159 | |
160 | 1; |
161 | |