Commit | Line | Data |
52185ab8 |
1 | package File::Tree::Snapshot; |
2 | use Moo; |
3 | use File::Path; |
4 | use File::Basename; |
5 | |
6 | our $VERSION = '0.000001'; |
7 | $VERSION = eval $VERSION; |
8 | |
9 | has storage_path => (is => 'ro', required => 1); |
10 | |
11 | has allow_empty => (is => 'ro'); |
12 | |
13 | sub file { join '/', (shift)->storage_path, @_} |
14 | |
15 | sub open { |
16 | my ($self, $mode, $file, %opt) = @_; |
17 | $file = $self->file($file) |
18 | unless $opt{is_absolute}; |
19 | $self->_mkpath(dirname $file) |
20 | if $opt{mkpath}; |
21 | open my $fh, $mode, $file |
22 | or die "Unable to write '$file': $!\n"; |
23 | return $fh; |
24 | } |
25 | |
26 | sub _mkpath { |
27 | my ($self, $dir) = @_; |
28 | mkpath($dir, { error => \(my $err) }); |
29 | if (@$err) { |
30 | warn "Error while attempting to create '$dir': $_\n" |
31 | for map { (values %$_) } @$err; |
32 | } |
33 | return 1; |
34 | } |
35 | |
36 | sub _exec { |
37 | my ($self, $cmd) = @_; |
38 | system($cmd) and die "Error during ($cmd)\n"; |
39 | return 1; |
40 | } |
41 | |
42 | sub _git_exec { |
43 | my ($self, @cmd) = @_; |
44 | my $path = $self->storage_path; |
45 | #local $ENV{GIT_DIR} = "$path/.git"; |
46 | return $self->_exec( |
47 | sprintf q{cd %s && git %s}, |
48 | $path, |
49 | join ' ', @cmd, |
50 | ); |
51 | } |
52 | |
53 | sub create { |
54 | my ($self) = @_; |
55 | my $path = $self->storage_path; |
56 | $self->_mkpath($path); |
57 | $self->_git_exec('init'); |
58 | return 1; |
59 | } |
60 | |
61 | sub _has_changes { |
62 | my ($self) = @_; |
63 | my $path = $self->storage_path; |
64 | my @changes = `cd $path && git diff --name-only --cached`; |
65 | return scalar @changes; |
66 | } |
67 | |
68 | sub commit { |
69 | my ($self) = @_; |
70 | $self->_git_exec('add .'); |
71 | unless ($self->_has_changes) { |
72 | print "No changes\n"; |
73 | return 1; |
74 | } |
75 | $self->_git_exec('commit', |
76 | '--all', |
77 | ($self->allow_empty ? '--allow-empty' : ()), |
78 | '-m' => sprintf('"Updated on %s"', scalar localtime), |
79 | ); |
80 | return 1; |
81 | } |
82 | |
83 | sub reset { |
84 | my ($self) = @_; |
85 | $self->_git_exec('add .'); |
86 | $self->_git_exec('checkout -f'); |
87 | return 1; |
88 | } |
89 | |
90 | sub exists { |
91 | my ($self) = @_; |
92 | return -e join '/', $self->storage_path, '.git'; |
93 | } |
94 | |
95 | sub find_files { |
96 | my ($self, $ext, @path) = @_; |
97 | my $root = $self->file(@path); |
98 | my @files = `find $root -name '*.$ext' -type f`; |
99 | chomp @files; |
100 | return @files; |
101 | } |
102 | |
103 | 1; |
ed0958d7 |
104 | |
105 | =head1 NAME |
106 | |
107 | File::Tree::Snapshot - Snapshot files in a git repository |
108 | |
109 | =head1 SYNOPSIS |
110 | |
111 | use File::Tree::Snapshot; |
112 | |
113 | my $tree = File::Tree::Snapshot->new( |
114 | storage_path => '/path/to/tree', |
115 | ); |
116 | |
117 | $tree->create |
118 | unless $tree->exists; |
119 | |
120 | # modify files, see methods below |
121 | |
122 | $tree->commit; |
123 | # or |
124 | $tree->reset; |
125 | |
126 | =head1 DESCRIPTION |
127 | |
128 | This module manages snapshots of file system trees by wrapping the C<git> |
129 | command line interface. It currently only manages generating the snapshots. |
130 | |
131 | The directories are standard Git repositories and can be accessed in the |
132 | usual ways. |
133 | |
134 | =head1 ATTRIBUTES |
135 | |
136 | =head2 storage_path |
137 | |
138 | The path to the tree that should hold the files that are snapshot. This |
139 | attribute is required. |
140 | |
141 | =head2 allow_empty |
142 | |
143 | If this attribute is set to true, commits will be created even if no changes |
144 | were registered. |
145 | |
146 | =head1 METHODS |
147 | |
148 | =head2 new |
149 | |
150 | my $tree = File::Tree::Snapshot->new(%attributes); |
151 | |
152 | Constructor. See L</ATTRIBUTES> for possible parameters. |
153 | |
154 | =head2 file |
155 | |
156 | my $path = $tree->file(@relative_path_parts_to_file); |
157 | |
158 | Takes a set of path parts and returns the path to the file inside the |
159 | storage. |
160 | |
161 | =head2 open |
162 | |
163 | my $fh = $tree->open($mode, $file, %options); |
164 | |
165 | Opens a file within the storage. C<$mode> is passed straight to |
166 | L<perlfunc/open>. The C<$file> is a relative path inside the storage. |
167 | |
168 | Possible options are: |
169 | |
170 | =over |
171 | |
172 | =item * C<is_absolute> |
173 | |
174 | If set to true the C<$file> will be assumed to already be an absolute |
175 | path as returned by L</file>, instead of a path relative to the storage. |
176 | |
177 | =item * C<mkpath> |
178 | |
179 | Create the path to the file if it doesn't already exist. |
180 | |
181 | =back |
182 | |
183 | =head2 create |
184 | |
185 | $tree->create; |
186 | |
187 | Create the directory (if it doesn't exist yet) and initialize it as a |
188 | Git repository. |
189 | |
190 | =head2 exists |
191 | |
192 | my $does_exist = $tree->exists; |
193 | |
194 | Returns true if the storage is an initialized Git repository. |
195 | |
196 | =head2 commit |
197 | |
198 | Will commit the changes made to the tree to the Git repository. |
199 | |
200 | =head2 reset |
201 | |
202 | Rolls back the changes since the last snapshot. |
203 | |
204 | =cut |