Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # -*- perl -*- |
2 | ||
3 | package Midas::Paths; | |
4 | use strict; | |
5 | ||
6 | require Exporter; | |
7 | use Cwd; | |
8 | use File::Spec; | |
9 | ||
10 | ||
11 | use Midas::Command; | |
12 | use Midas::Error; | |
13 | ||
14 | our @ISA = qw(Exporter); | |
15 | our @EXPORT = qw(cd compact_path full_path | |
16 | path_to_build_file); | |
17 | ||
18 | our $Full_paths = 0; | |
19 | ||
20 | ############################################################################## | |
21 | ||
22 | # Note this function is not at all robust. Should work on that | |
23 | sub are_dirs_same { | |
24 | my $dir1 = shift; | |
25 | my $dir2 = shift; | |
26 | ||
27 | my $canon_dir1 = File::Spec->canonpath(File::Spec->rel2abs($dir1)); | |
28 | my $canon_dir2 = File::Spec->canonpath(File::Spec->rel2abs($dir2)); | |
29 | ||
30 | return ($canon_dir1 eq $canon_dir2); | |
31 | } | |
32 | ||
33 | ############################################################################## | |
34 | ||
35 | # ACTUALLY A CLASS METHOD | |
36 | sub pushd { | |
37 | my $class = shift; | |
38 | my $dir = shift; | |
39 | ||
40 | my $this = {}; | |
41 | bless $this, $class; | |
42 | ||
43 | if(not are_dirs_same($dir, getcwd)) { | |
44 | $this->{old} = getcwd; | |
45 | cd($dir); | |
46 | } | |
47 | ||
48 | return $this; | |
49 | } | |
50 | ||
51 | ############################################################################## | |
52 | ||
53 | # Not for public consumption | |
54 | sub popd { | |
55 | my $this = shift; | |
56 | return unless defined $this->{old}; | |
57 | cd(compact_path($this->{old})); | |
58 | } | |
59 | ||
60 | ############################################################################## | |
61 | ||
62 | # implicit call to popd | |
63 | sub DESTROY { | |
64 | my $this = shift; | |
65 | $this->popd(); | |
66 | } | |
67 | ||
68 | ############################################################################## | |
69 | ||
70 | sub opt_full_paths { | |
71 | return $$Full_paths if ref $Full_paths; | |
72 | return $Full_paths; | |
73 | } | |
74 | ||
75 | ############################################################################## | |
76 | ||
77 | sub configure { | |
78 | my %args = @_; | |
79 | ||
80 | foreach my $key (keys %args) { | |
81 | if($key eq 'full_paths') { | |
82 | $Full_paths = $args{$key}; | |
83 | } else { | |
84 | fatal "Midas::Paths does not recongnize configuration option ". | |
85 | "$key.\n", M_BADCONFIG; | |
86 | } | |
87 | } | |
88 | ||
89 | return ( full_paths => opt_full_paths ); | |
90 | ||
91 | } | |
92 | ||
93 | ############################################################################## | |
94 | ||
95 | # compact_path | |
96 | # Converts to full or relative (to $relto or cwd) path, whichever is shorter. | |
97 | # If Full_Paths is enabled, then always return full path. | |
98 | ||
99 | ############################################################################## | |
100 | ||
101 | sub compact_path { | |
102 | my $path = shift; | |
103 | my $relto = shift; | |
104 | ||
105 | $relto = getcwd unless defined $relto; | |
106 | my $abs = File::Spec->rel2abs($path, $relto); | |
107 | my $rel = File::Spec->abs2rel($abs, $relto); | |
108 | ||
109 | my $compact = ((length $rel) < (length $abs)) ? $rel : $abs; | |
110 | $compact = '.' if length($compact) == 0; | |
111 | ||
112 | return opt_full_paths() ? $abs : $compact; | |
113 | } | |
114 | ||
115 | ############################################################################## | |
116 | ||
117 | sub full_path { | |
118 | my $path = shift; | |
119 | my $relto = shift; | |
120 | ||
121 | $relto = getcwd unless defined $relto; | |
122 | my $abs = File::Spec->rel2abs($path, $relto); | |
123 | return $abs; | |
124 | } | |
125 | ||
126 | ############################################################################## | |
127 | ||
128 | sub cd { | |
129 | my $dir = shift; | |
130 | if(opt_full_paths()) { | |
131 | $dir = File::Spec->rel2abs($dir); | |
132 | } | |
133 | chat "cd $dir\n"; | |
134 | chdir $dir or fatal "Can't cd to $dir: $!\n", M_DIR; | |
135 | } | |
136 | ||
137 | ############################################################################## | |
138 | ||
139 | # Get filename. $file argument is a full path or a path relative to | |
140 | # build_dir. Second argument defines build_dir. If no second | |
141 | # argument, assume build_dir is cwd. If it's a string, assume the | |
142 | # string is build_dir. If it's a reference, assume it's a | |
143 | # Midas::State object. Return value is the compact path to the file. | |
144 | ||
145 | ############################################################################## | |
146 | ||
147 | sub path_to_build_file { | |
148 | my $file = shift; | |
149 | my $arg = shift; # either build_dir or state object or undef for build=cwd | |
150 | ||
151 | my $build_dir; | |
152 | if(not defined $arg) { | |
153 | $build_dir = getcwd; | |
154 | } elsif (ref $arg) { | |
155 | my $state = $arg; | |
156 | ||
157 | # Do the require at this late date so as to not mess up exports | |
158 | # (this is a circular include). | |
159 | ||
160 | require Midas::State; | |
161 | ||
162 | $build_dir = $state->get_build_dir('-abs'); | |
163 | } else { | |
164 | $build_dir = $arg; | |
165 | } | |
166 | ||
167 | my $expanded_file; | |
168 | if($file =~ m|^/|) { | |
169 | $expanded_file = $file; | |
170 | } else { | |
171 | $expanded_file = File::Spec->rel2abs($file, $build_dir); | |
172 | } | |
173 | ||
174 | return compact_path $expanded_file; | |
175 | } | |
176 | ||
177 | ############################################################################## | |
178 | ############################################################################## | |
179 | ||
180 | 1; |