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; |
3e82afa2 |
66 | my $cmd = qq{cd $path && git diff --name-only --cached}; |
67 | CORE::open my $handle, '-|', $cmd |
68 | or die "Unable to find changes in ($cmd): $!\n"; |
69 | my @changes = <$handle>; |
52185ab8 |
70 | return scalar @changes; |
71 | } |
72 | |
73 | sub commit { |
74 | my ($self) = @_; |
75 | $self->_git_exec('add .'); |
76 | unless ($self->_has_changes) { |
77 | print "No changes\n"; |
78 | return 1; |
79 | } |
80 | $self->_git_exec('commit', |
81 | '--all', |
82 | ($self->allow_empty ? '--allow-empty' : ()), |
83 | '-m' => sprintf('"Updated on %s"', scalar localtime), |
84 | ); |
85 | return 1; |
86 | } |
87 | |
88 | sub reset { |
89 | my ($self) = @_; |
90 | $self->_git_exec('add .'); |
aff04a36 |
91 | return 1 |
92 | unless $self->_has_changes; |
52185ab8 |
93 | $self->_git_exec('checkout -f'); |
94 | return 1; |
95 | } |
96 | |
97 | sub exists { |
98 | my ($self) = @_; |
99 | return -e join '/', $self->storage_path, '.git'; |
100 | } |
101 | |
102 | sub find_files { |
103 | my ($self, $ext, @path) = @_; |
104 | my $root = $self->file(@path); |
105 | my @files = `find $root -name '*.$ext' -type f`; |
106 | chomp @files; |
107 | return @files; |
108 | } |
109 | |
110 | 1; |
ed0958d7 |
111 | |
112 | =head1 NAME |
113 | |
114 | File::Tree::Snapshot - Snapshot files in a git repository |
115 | |
116 | =head1 SYNOPSIS |
117 | |
118 | use File::Tree::Snapshot; |
119 | |
120 | my $tree = File::Tree::Snapshot->new( |
121 | storage_path => '/path/to/tree', |
122 | ); |
123 | |
124 | $tree->create |
125 | unless $tree->exists; |
126 | |
127 | # modify files, see methods below |
128 | |
129 | $tree->commit; |
130 | # or |
131 | $tree->reset; |
132 | |
133 | =head1 DESCRIPTION |
134 | |
135 | This module manages snapshots of file system trees by wrapping the C<git> |
136 | command line interface. It currently only manages generating the snapshots. |
137 | |
138 | The directories are standard Git repositories and can be accessed in the |
139 | usual ways. |
140 | |
141 | =head1 ATTRIBUTES |
142 | |
143 | =head2 storage_path |
144 | |
145 | The path to the tree that should hold the files that are snapshot. This |
146 | attribute is required. |
147 | |
148 | =head2 allow_empty |
149 | |
150 | If this attribute is set to true, commits will be created even if no changes |
151 | were registered. |
152 | |
153 | =head1 METHODS |
154 | |
155 | =head2 new |
156 | |
157 | my $tree = File::Tree::Snapshot->new(%attributes); |
158 | |
159 | Constructor. See L</ATTRIBUTES> for possible parameters. |
160 | |
161 | =head2 file |
162 | |
163 | my $path = $tree->file(@relative_path_parts_to_file); |
164 | |
165 | Takes a set of path parts and returns the path to the file inside the |
166 | storage. |
167 | |
168 | =head2 open |
169 | |
170 | my $fh = $tree->open($mode, $file, %options); |
171 | |
172 | Opens a file within the storage. C<$mode> is passed straight to |
173 | L<perlfunc/open>. The C<$file> is a relative path inside the storage. |
174 | |
175 | Possible options are: |
176 | |
177 | =over |
178 | |
179 | =item * C<is_absolute> |
180 | |
181 | If set to true the C<$file> will be assumed to already be an absolute |
182 | path as returned by L</file>, instead of a path relative to the storage. |
183 | |
184 | =item * C<mkpath> |
185 | |
186 | Create the path to the file if it doesn't already exist. |
187 | |
188 | =back |
189 | |
190 | =head2 create |
191 | |
192 | $tree->create; |
193 | |
194 | Create the directory (if it doesn't exist yet) and initialize it as a |
195 | Git repository. |
196 | |
197 | =head2 exists |
198 | |
199 | my $does_exist = $tree->exists; |
200 | |
201 | Returns true if the storage is an initialized Git repository. |
202 | |
203 | =head2 commit |
204 | |
205 | Will commit the changes made to the tree to the Git repository. |
206 | |
207 | =head2 reset |
208 | |
209 | Rolls back the changes since the last snapshot. |
210 | |
7bc85892 |
211 | =head1 SPONSORED |
212 | |
213 | The development of this module was sponsored by L<http://socialflow.com/>. |
214 | |
ed0958d7 |
215 | =cut |