move actions to a separate state attribute
[scpubgit/DKit.git] / lib / DX / Lib / FS.pm
CommitLineData
4d2ad771 1package DX::Lib::FS;
2
3use DX::Lib::FS::Observation::PathStatus;
4use DX::Lib::FS::Action::CreateDirectory;
5use DX::Lib::FS::Action::CreateFile;
ae75ed8b 6use DX::Lib::FS::Action::SetPathMode;
4d2ad771 7use File::Spec;
8use DX::SetOver;
9use Moo;
10
11our @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
102sub 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
1391;