Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # -*- perl -*- |
2 | ||
3 | package Midas::State; | |
4 | use strict; | |
5 | ||
6 | use File::Spec; | |
7 | use Cwd; | |
8 | ||
9 | use Midas::MMU; | |
10 | use Midas::Configure; | |
11 | use Midas::Command; | |
12 | use Midas::Paths; | |
13 | use Midas::Globals; | |
14 | use Midas::Error; | |
15 | ||
16 | require Exporter; | |
17 | our @ISA = qw(Exporter); | |
18 | our @EXPORT = qw(init_state); | |
19 | our @EXPORT_OK = qw(); | |
20 | ||
21 | use fields qw( | |
22 | start_dir | |
23 | build_dir | |
24 | dest_dir | |
25 | ||
26 | diag_root | |
27 | ||
28 | created_build_dir | |
29 | skipping_build | |
30 | ||
31 | mmu | |
32 | tsbs | |
33 | tsblinks | |
34 | ||
35 | apps | |
36 | ); | |
37 | ||
38 | ############################################################################## | |
39 | ||
40 | sub init_state { | |
41 | my $diag_root = shift; | |
42 | my $start_dir = shift; | |
43 | my $dest_dir = shift; | |
44 | ||
45 | $diag_root = $ENV{DV_ROOT} unless defined $diag_root; | |
46 | $start_dir = getcwd unless defined $start_dir; | |
47 | $dest_dir = getcwd unless defined $start_dir; | |
48 | ||
49 | $diag_root = File::Spec->rel2abs($diag_root, getcwd); | |
50 | $start_dir = File::Spec->rel2abs($start_dir, getcwd); | |
51 | $dest_dir = File::Spec->rel2abs($dest_dir, getcwd); | |
52 | ||
53 | my $state = Midas::State->new(start_dir => $start_dir, | |
54 | dest_dir => $dest_dir, | |
55 | diag_root => $diag_root, | |
56 | ); | |
57 | ||
58 | ||
59 | $state->set_build_dir($state->get_build_dir()); | |
60 | ||
61 | $ENV{DIAG_ROOT} = $diag_root; | |
62 | $ENV{START_DIR} = $start_dir; | |
63 | $ENV{DEST_DIR} = $dest_dir; | |
64 | ||
65 | return $state; | |
66 | } | |
67 | ||
68 | ############################################################################## | |
69 | ||
70 | sub new { | |
71 | my $this = shift; | |
72 | my %args = @_; | |
73 | ||
74 | unless (ref $this) { | |
75 | $this = fields::new($this); | |
76 | } | |
77 | ||
78 | $this->set_defaults(); | |
79 | ||
80 | foreach my $key (keys %args) { | |
81 | $this->{$key} = $args{$key}; | |
82 | } | |
83 | return $this; | |
84 | } | |
85 | ||
86 | ############################################################################## | |
87 | ||
88 | sub set_defaults { | |
89 | my $this = shift; | |
90 | ||
91 | $this->{start_dir} = '.'; | |
92 | $this->{build_dir} = undef; | |
93 | $this->{dest_dir} = '.'; | |
94 | $this->{diag_root} = $ENV{DV_ROOT}; | |
95 | $this->{created_build_dir} = 0; | |
96 | $this->{skipping_build} = 0; | |
97 | $this->{mmu} = undef; | |
98 | $this->{apps} = {}; | |
99 | $this->{tsbs} = {}; | |
100 | $this->{tsblinks} = {}; | |
101 | } | |
102 | ||
103 | ############################################################################## | |
104 | ||
105 | sub get_build_dir { | |
106 | my $this = shift; | |
107 | my @args = @_; | |
108 | ||
109 | my $build = $this->{build_dir}; | |
110 | if(not defined $build) { | |
111 | $build = $CONFIG{build_dir}; | |
112 | } | |
113 | my $build_abs = File::Spec->rel2abs($build, $this->{start_dir}); | |
114 | ||
115 | if(grep /^\-abs$/, @args) { | |
116 | return $build_abs; | |
117 | } | |
118 | ||
119 | return compact_path($build_abs); | |
120 | } | |
121 | ||
122 | ############################################################################## | |
123 | ||
124 | sub set_build_dir { | |
125 | my $this = shift; | |
126 | my $build_dir = shift; | |
127 | ||
128 | my $build = File::Spec->rel2abs($build_dir, $this->{start_dir}); | |
129 | $this->{build_dir} = $build; | |
130 | return $this->{build_dir}; | |
131 | } | |
132 | ||
133 | ############################################################################## | |
134 | ||
135 | sub get_start_dir { | |
136 | my $this = shift; | |
137 | my @args = @_; | |
138 | ||
139 | my $start_dir = $this->{start_dir}; | |
140 | ||
141 | if(grep /^\-abs$/, @args) { | |
142 | return $start_dir; | |
143 | } | |
144 | ||
145 | return compact_path $start_dir; | |
146 | } | |
147 | ||
148 | ############################################################################## | |
149 | ||
150 | sub get_dest_dir { | |
151 | my $this = shift; | |
152 | my @args = @_; | |
153 | ||
154 | my $dest_dir = $this->{dest_dir}; | |
155 | ||
156 | if(grep /^\-abs$/, @args) { | |
157 | return $dest_dir; | |
158 | } | |
159 | ||
160 | return compact_path $dest_dir; | |
161 | } | |
162 | ||
163 | ############################################################################## | |
164 | ||
165 | sub set_dest_dir { | |
166 | my $this = shift; | |
167 | my $dest_dir = shift; | |
168 | ||
169 | $this->{dest_dir} = File::Spec->rel2abs($dest_dir); | |
170 | } | |
171 | ||
172 | ############################################################################## | |
173 | ||
174 | sub get_created_build_dir { | |
175 | my $this = shift; | |
176 | ||
177 | return $this->{created_build_dir}; | |
178 | } | |
179 | ||
180 | ############################################################################## | |
181 | ||
182 | sub set_created_build_dir { | |
183 | my $this = shift; | |
184 | my $val = shift; | |
185 | ||
186 | $val = 1 unless defined $val; | |
187 | $this->{created_build_dir} = $val; | |
188 | return $this->{created_build_dir}; | |
189 | } | |
190 | ||
191 | ############################################################################## | |
192 | ||
193 | sub get_diag_root { | |
194 | my $this = shift; | |
195 | ||
196 | return $this->{diag_root}; | |
197 | } | |
198 | ||
199 | ############################################################################## | |
200 | ||
201 | sub get_mmu { | |
202 | my $this = shift; | |
203 | my $type = shift; | |
204 | ||
205 | fatal "Tried to get mmu of specified type $type when an mmu already ". | |
206 | "exists!\n", M_CODE if defined $type && defined $this->{mmu}; | |
207 | ||
208 | return $this->{mmu} if defined $this->{mmu}; | |
209 | ||
210 | my $mmu = create_mmu( defined $type ? $type : $CONFIG{mmu_type} ); | |
211 | $this->{mmu} = $mmu; | |
212 | return $this->{mmu}; | |
213 | } | |
214 | ||
215 | ############################################################################## | |
216 | ||
217 | sub clear { | |
218 | my $this = shift; | |
219 | $this->set_defaults(); | |
220 | } | |
221 | ||
222 | ############################################################################## | |
223 | ||
224 | sub skipping_build { | |
225 | my $this = shift; | |
226 | my $bool = shift; | |
227 | $this->{skipping_build} = $bool if defined $bool; | |
228 | return $this->{skipping_build}; | |
229 | } | |
230 | ||
231 | ############################################################################## | |
232 | ||
233 | sub get_tsb { | |
234 | my $this = shift; | |
235 | my $name = shift; | |
236 | ||
237 | return $this->{tsbs}{$name} if exists $this->{tsbs}{$name}; | |
238 | return; | |
239 | } | |
240 | ||
241 | ############################################################################## | |
242 | ||
243 | sub get_tsblink { | |
244 | my $this = shift; | |
245 | my $name = shift; | |
246 | ||
247 | return $this->{tsblinks}{$name} if exists $this->{tsblinks}{$name}; | |
248 | return; | |
249 | } | |
250 | ||
251 | ############################################################################## | |
252 | 1; |