Commit | Line | Data |
4d2ad771 |
1 | package DX::Lib::FS; |
2 | |
3 | use DX::Lib::FS::Observation::PathStatus; |
4 | use DX::Lib::FS::Action::CreateDirectory; |
5 | use DX::Lib::FS::Action::CreateFile; |
ae75ed8b |
6 | use DX::Lib::FS::Action::SetPathMode; |
8c3eab7b |
7 | use DX::Lib::FS::Observation::FileContent; |
8 | use DX::Lib::FS::Action::RewriteFile; |
4d2ad771 |
9 | use File::Spec; |
10 | use DX::SetOver; |
11 | use Moo; |
12 | |
13 | our @RULES = ( |
14 | [ path_status => [ qw(PS) ], |
15 | [ member_of => 'PS', \'path_status' ] ], |
dd866f63 |
16 | |
17 | [ _path_status_at => [ qw(PS P) ], |
4d2ad771 |
18 | [ path_status => 'PS' ], |
dd866f63 |
19 | [ prop => PS => \'path' => 'P' ] ], |
20 | |
21 | [ path_status_at => [ qw(PS P) ], |
22 | [ _path_status_at => qw(PS P) ], |
4d2ad771 |
23 | [ 'cut' ] ], |
dd866f63 |
24 | |
4d2ad771 |
25 | [ path_status_at => [ 'PS', 'P' ], |
26 | [ observe => [ 'P' ], sub { |
27 | DX::Lib::FS::Observation::PathStatus->new( |
28 | path => $_[0] |
29 | ) |
30 | } ], |
dd866f63 |
31 | [ _path_status_at => qw(PS P) ] ], |
32 | |
33 | [ ps_prop => [ 'P', 'Name', 'Value' ], |
34 | [ exists => [ 'PS' ], |
35 | [ path_status_at => qw(PS P) ], |
36 | [ prop => qw(PS Name Value) ] ] ], |
37 | |
38 | [ ps_info_prop => [ 'P', 'Name', 'Value' ], |
39 | [ exists => [ 'PSI' ], |
40 | [ ps_prop => 'P', \'info', 'PSI' ], |
41 | [ prop => 'PSI', 'Name', 'Value' ] ] ], |
42 | |
43 | [ exists_path => [ qw(P) ], |
44 | [ exists => [ qw(PSI) ], [ ps_prop => 'P' => \'info' => 'PSI' ] ] ], |
45 | |
46 | [ _is_directory => [ qw(P) ], |
47 | [ ps_info_prop => 'P' => \'is_directory' => \1 ] ], |
48 | |
49 | [ is_directory => [ qw(P) ], |
50 | [ _is_directory => 'P' ] ], |
51 | |
52 | [ _is_file => [ qw(P) ], |
53 | [ ps_info_prop => 'P' => \'is_file' => \1 ] ], |
54 | |
55 | [ is_file => [ qw(P) ], |
56 | [ _is_file => 'P' ] ], |
57 | |
58 | [ _mode => [ qw(P M) ], |
59 | [ ps_info_prop => 'P' => \'mode' => 'M' ] ], |
60 | |
61 | [ mode => [ qw(P M) ], |
62 | [ _mode => qw(P M) ] ], |
63 | |
64 | [ is_directory => [ 'Path' ], |
65 | [ not => [ _is_directory => 'Path' ] ], |
66 | [ act => [ 'Path' ], sub { |
4d2ad771 |
67 | DX::Lib::FS::Action::CreateDirectory->new( |
dd866f63 |
68 | path => $_[0], |
4d2ad771 |
69 | ) |
dd866f63 |
70 | } ], |
71 | [ _is_directory => 'Path' ] ], |
72 | |
73 | [ is_file => [ 'Path' ], |
74 | [ not => [ _is_file => 'Path' ] ], |
75 | [ act => [ 'Path' ], sub { |
4d2ad771 |
76 | DX::Lib::FS::Action::CreateFile->new( |
dd866f63 |
77 | path => $_[0], |
4d2ad771 |
78 | ) |
dd866f63 |
79 | } ], |
80 | [ _is_file => 'Path' ] ], |
81 | |
82 | [ _action_is_creating => [ qw(A) ], |
83 | [ does => 'A', \'DX::Lib::FS::Action::CreateDirectory' ] ], |
84 | |
85 | [ _action_is_creating => [ qw(A) ], |
86 | [ does => 'A', \'DX::Lib::FS::Action::CreateFile' ] ], |
87 | |
88 | [ mode => [ qw(P M) ], |
89 | [ exists => [ qw(PS A) ], |
90 | [ path_status_at => qw(PS P) ], |
640fa37e |
91 | [ has_action => qw(PS A) ], |
dd866f63 |
92 | [ _action_is_creating => 'A' ], |
640fa37e |
93 | [ react => [ qw(PS M) ], sub { |
94 | $_[0]->but(mode => $_[1]); |
6d55e4c6 |
95 | } ] ], |
dd866f63 |
96 | [ 'cut' ] ], |
97 | |
98 | [ mode => [ qw(P M) ], |
99 | [ exists => [ qw(PS) ], |
100 | [ path_status_at => qw(PS P) ], |
101 | [ not => [ _mode => qw(P M) ] ], |
102 | [ act => [ qw(PS M) ], sub { |
103 | DX::Lib::FS::Action::SetPathMode->new( |
104 | path_status => $_[0], mode => $_[1] |
105 | ) |
106 | } ] ], |
107 | [ 'cut' ] ], |
108 | |
8c3eab7b |
109 | [ file_content => [ qw(FC) ], |
110 | [ member_of => 'FC', \'file_content' ] ], |
dd866f63 |
111 | |
112 | [ _file_content_at => [ qw(FC P) ], |
8c3eab7b |
113 | [ file_content => 'FC' ], |
dd866f63 |
114 | [ prop => 'FC', \'path', 'P' ] ], |
115 | |
116 | [ file_content_at => [ qw(FC P) ], |
117 | [ _file_content_at => qw(FC P) ], |
8c3eab7b |
118 | [ 'cut' ] ], |
dd866f63 |
119 | |
8c3eab7b |
120 | [ file_content_at => [ qw(FC P) ], |
dd866f63 |
121 | [ is_file => 'P' ], |
8c3eab7b |
122 | [ observe => [ 'P' ], sub { |
123 | DX::Lib::FS::Observation::FileContent->new( |
124 | path => $_[0] |
125 | ) |
126 | } ], |
dd866f63 |
127 | [ _file_content_at => qw(FC P) ] ], |
128 | |
129 | [ fc_prop => [ qw(P Name Value) ], |
130 | [ exists => [ 'FC' ], |
131 | [ file_content_at => qw(FC P) ], |
132 | [ prop => qw(FC Name Value) ] ] ], |
133 | |
134 | [ file_data => [ qw(P D) ], [ fc_prop => 'P', \'data', 'D' ] ], |
135 | |
136 | [ _contains_line => [ qw(P L) ], |
137 | [ is_file => 'P' ], |
8c3eab7b |
138 | [ exists => [ 'Lines' ], |
dd866f63 |
139 | [ fc_prop => 'P', \'lines', 'Lines' ], |
140 | [ member_of => qw(L Lines) ] ] ], |
141 | |
142 | [ contains_line => [ qw(P L) ], |
143 | [ _contains_line => qw(P L) ] ], |
144 | |
145 | [ _action_modifying_fc => [ 'A' ], |
146 | [ does => 'A' => \'DX::Lib::FS::Action::CreateFile' ] ], |
147 | |
148 | [ _action_modifying_fc => [ 'A' ], |
149 | [ does => 'A' => \'DX::Lib::FS::Action::RewriteFile' ] ], |
150 | |
151 | [ contains_line => [ qw(P L) ], |
152 | [ not => [ _contains_line => qw(P L) ] ], |
153 | [ exists => [ qw(FC A) ], |
8c3eab7b |
154 | [ file_content_at => qw(FC P) ], |
8c3eab7b |
155 | [ has_action => qw(FC A) ], |
dd866f63 |
156 | [ _action_modifying_fc => 'A' ], |
157 | [ react => [ qw(FC L) ], sub { |
158 | $_[0]->but_add($_[1]) |
159 | } ] ], |
8c3eab7b |
160 | [ 'cut' ] ], |
dd866f63 |
161 | |
162 | [ contains_line => [ qw(P L) ], |
163 | [ not => [ _contains_line => qw(P L) ] ], |
164 | [ exists => [ qw(FC) ], |
165 | [ file_content_at => qw(FC P) ], |
166 | [ act => [ qw(FC L) ], sub { |
8c3eab7b |
167 | DX::Lib::FS::Action::RewriteFile->new( |
168 | from => $_[0], |
dd866f63 |
169 | )->but_add($_[1]) |
170 | } ] ] ], |
171 | |
172 | [ not_contains_line => [ qw(P L) ], |
173 | [ not => [ _contains_line => qw(P L) ] ] ], |
174 | |
175 | [ _arrange_removal_of => [ qw(FC L) ], |
8c3eab7b |
176 | [ exists => [ 'A' ], |
177 | [ has_action => qw(FC A) ], |
178 | [ does => 'A' => \'DX::Lib::FS::Action::RewriteFile' ] ], |
dd866f63 |
179 | [ react => [ qw(FC L) ], sub { $_[0]->but_remove($_[1]) } ] ], |
180 | |
181 | [ _arrange_removal_of => [ qw(FC L) ], |
8c3eab7b |
182 | [ act => [ qw(FC L) ], sub { |
183 | DX::Lib::FS::Action::RewriteFile->new( |
184 | from => $_[0], |
dd866f63 |
185 | )->but_remove($_[1]); |
186 | } ] ], |
187 | |
188 | [ not_contains_line => [ qw(P L) ], |
189 | [ _contains_line => qw(P L) ], |
190 | [ exists => [ qw(FC) ], |
191 | [ file_content_at => qw(FC P) ], |
192 | [ _arrange_removal_of => qw(FC L) ], |
193 | ], |
8c3eab7b |
194 | [ 'cut' ] ], |
dd866f63 |
195 | |
196 | [ file_in => [ qw(DirPath FileName FilePath) ], |
197 | [ catfile => qw(DirPath FileName FilePath) ], |
198 | [ is_directory => 'DirPath' ], |
199 | [ is_file => 'FilePath' ] ], |
4d2ad771 |
200 | ); |
201 | |
202 | sub load_into { |
203 | my ($self, $solver) = @_; |
204 | $solver->facts->{path_status} = DX::SetOver->new(over => 'path'); |
8c3eab7b |
205 | $solver->facts->{file_content} = DX::SetOver->new(over => 'path'); |
4d2ad771 |
206 | $solver->add_predicate( |
207 | catdir => [ qw(DirPath DirName SubDirPath) ], |
208 | [ qw(+ + -) ] => sub { |
209 | +(SubDirPath => [ |
210 | value => File::Spec->catdir($_{DirPath}, $_{DirName}) |
211 | ]) |
212 | }, |
213 | [ qw(- - +) ] => sub { |
214 | my @split = File::Spec->splitdir($_{SubDirPath}); |
215 | my $last = pop @split; |
216 | my $rest = File::Spec->catdir(@split); |
217 | +(DirPath => [ value => $rest ], DirName => [ value => $last ]) |
218 | } |
219 | ); |
220 | $solver->add_predicate( |
221 | catfile => [ qw(DirPath FileName FilePath) ], |
222 | [ qw(+ + -) ] => sub { |
223 | my ($vol, $dir) = File::Spec->splitpath($_{DirPath}, 1); |
640fa37e |
224 | my $file_path = File::Spec->catpath($vol, $dir, $_{FileName}); |
4d2ad771 |
225 | +(FilePath => [ value => $file_path ]) |
226 | }, |
227 | [ qw(- - +) ] => sub { |
228 | my ($vol, $dir, $file) = File::Spec->splitpath($_{FilePath}); |
229 | my $dir_path = File::Spec->catpath($vol, $dir); |
230 | +(DirPath => [ value => $dir_path ], FileName => [ value => $file ]) |
231 | } |
232 | ); |
640fa37e |
233 | $solver->add_rule( |
234 | does => [ qw(Thing RoleName) ], |
235 | [ constrain => [ qw(Thing RoleName) ], sub { $_[0]->DOES($_[1]) } ] |
236 | ); |
4d2ad771 |
237 | $solver->add_rule(@$_) for @RULES; |
238 | } |
239 | |
240 | 1; |