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