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