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; |
4d2ad771 |
7 | use File::Spec; |
8 | use DX::SetOver; |
9 | use Moo; |
10 | |
11 | our @RULES = ( |
12 | [ path_status => [ qw(PS) ], |
13 | [ member_of => 'PS', \'path_status' ] ], |
14 | [ path => [ qw(PS P) ], |
15 | [ prop => 'PS', \'path', 'P' ] ], |
16 | [ info_prop => [ qw(PS N V) ], |
17 | [ exists => [ qw(PSI) ], |
18 | [ prop => 'PS', \'info', 'PSI' ], |
19 | [ prop => 'PSI', 'N', 'V' ] ] ], |
20 | [ mode => [ qw(PS M) ], |
21 | [ info_prop => 'PS', \'mode', 'M' ] ], |
22 | [ exists_path => [ qw(PS) ], |
23 | [ info_prop => 'PS', \'is_directory', \1 ] ], |
24 | [ exists_path => [ qw(PS) ], |
25 | [ info_prop => 'PS', \'is_file', \1 ] ], |
26 | [ is_directory => [ qw(PS) ], |
27 | [ info_prop => 'PS', \'is_directory', \1 ] ], |
28 | [ is_file => [ qw(PS) ], |
29 | [ info_prop => 'PS', \'is_file', \1 ] ], |
30 | [ path_status_at => [ 'PS', 'P' ], |
31 | [ path_status => 'PS' ], |
32 | [ path => qw(PS P) ], |
33 | [ 'cut' ] ], |
34 | [ path_status_at => [ 'PS', 'P' ], |
35 | [ observe => [ 'P' ], sub { |
36 | DX::Lib::FS::Observation::PathStatus->new( |
37 | path => $_[0] |
38 | ) |
39 | } ], |
40 | [ path_status => 'PS' ], |
41 | [ path => qw(PS P) ] ], |
42 | [ directory_at => [ qw(PS P) ], |
43 | [ path_status_at => qw(PS P) ], |
44 | [ is_directory => 'PS' ] ], |
45 | [ file_at => [ qw(PS P) ], |
46 | [ path_status_at => qw(PS P) ], |
47 | [ is_file => 'PS' ] ], |
48 | [ is_directory => [ qw(PS) ], |
49 | [ not => [ exists_path => 'PS' ] ], |
50 | [ act => [ 'PS' ], sub { |
51 | DX::Lib::FS::Action::CreateDirectory->new( |
52 | path => $_[0]->path |
53 | ) |
54 | } ] ], |
55 | [ is_file => [ qw(PS) ], |
56 | [ not => [ exists_path => 'PS' ] ], |
57 | [ act => [ 'PS' ], sub { |
58 | DX::Lib::FS::Action::CreateFile->new( |
59 | path => $_[0]->path |
60 | ) |
61 | } ] ], |
62 | [ directory_in => [ qw(DirStatus DirName SubDirStatus) ], |
63 | [ is_directory => qw(DirStatus) ], |
64 | [ exists => [ qw(DirPath) ], |
65 | [ path => qw(DirStatus DirPath) ], |
66 | [ exists => [ qw(SubDirPath) ], |
67 | [ catfile => qw(DirPath DirName SubDirPath) ], |
68 | [ directory_at => qw(SubDirStatus SubDirPath) ] ] ] ], |
69 | [ file_in => [ qw(DirStatus FileName FileStatus) ], |
70 | [ is_directory => qw(DirStatus) ], |
71 | [ exists => [ qw(DirPath) ], |
72 | [ path => qw(DirStatus DirPath) ], |
73 | [ exists => [ qw(FilePath) ], |
74 | [ catfile => qw(DirPath FileName FilePath) ], |
75 | [ file_at => qw(FileStatus FilePath) ] ] ] ], |
640fa37e |
76 | [ mode => [ qw(PS M) ], |
77 | [ exists => [ qw(A) ], |
78 | [ has_action => qw(PS A) ], |
79 | [ does => 'A', \'DX::Lib::FS::Action::CreateDirectory' ], |
80 | [ react => [ qw(PS M) ], sub { |
81 | $_[0]->but(mode => $_[1]); |
6d55e4c6 |
82 | } ] ], |
83 | [ 'cut' ] ], |
640fa37e |
84 | [ mode => [ qw(PS M) ], |
85 | [ exists => [ qw(A) ], |
86 | [ has_action => qw(PS A) ], |
87 | [ does => 'A', \'DX::Lib::FS::Action::CreateFile' ], |
88 | [ react => [ qw(PS M) ], sub { |
89 | $_[0]->but(mode => $_[1]); |
6d55e4c6 |
90 | } ] ], |
91 | [ 'cut' ] ], |
ae75ed8b |
92 | [ mode => [ qw(PS M) ], |
93 | [ exists_path => qw(PS) ], |
94 | [ not => [ info_prop => 'PS', \'mode', 'M' ] ], |
95 | [ act => [ qw(PS M) ], sub { |
96 | DX::Lib::FS::Action::SetPathMode->new( |
97 | path_status => $_[0], mode => $_[1] |
98 | ) |
99 | } ] ], |
4d2ad771 |
100 | ); |
101 | |
102 | sub load_into { |
103 | my ($self, $solver) = @_; |
104 | $solver->facts->{path_status} = DX::SetOver->new(over => 'path'); |
105 | $solver->add_predicate( |
106 | catdir => [ qw(DirPath DirName SubDirPath) ], |
107 | [ qw(+ + -) ] => sub { |
108 | +(SubDirPath => [ |
109 | value => File::Spec->catdir($_{DirPath}, $_{DirName}) |
110 | ]) |
111 | }, |
112 | [ qw(- - +) ] => sub { |
113 | my @split = File::Spec->splitdir($_{SubDirPath}); |
114 | my $last = pop @split; |
115 | my $rest = File::Spec->catdir(@split); |
116 | +(DirPath => [ value => $rest ], DirName => [ value => $last ]) |
117 | } |
118 | ); |
119 | $solver->add_predicate( |
120 | catfile => [ qw(DirPath FileName FilePath) ], |
121 | [ qw(+ + -) ] => sub { |
122 | my ($vol, $dir) = File::Spec->splitpath($_{DirPath}, 1); |
640fa37e |
123 | my $file_path = File::Spec->catpath($vol, $dir, $_{FileName}); |
4d2ad771 |
124 | +(FilePath => [ value => $file_path ]) |
125 | }, |
126 | [ qw(- - +) ] => sub { |
127 | my ($vol, $dir, $file) = File::Spec->splitpath($_{FilePath}); |
128 | my $dir_path = File::Spec->catpath($vol, $dir); |
129 | +(DirPath => [ value => $dir_path ], FileName => [ value => $file ]) |
130 | } |
131 | ); |
640fa37e |
132 | $solver->add_rule( |
133 | does => [ qw(Thing RoleName) ], |
134 | [ constrain => [ qw(Thing RoleName) ], sub { $_[0]->DOES($_[1]) } ] |
135 | ); |
4d2ad771 |
136 | $solver->add_rule(@$_) for @RULES; |
137 | } |
138 | |
139 | 1; |