added sponsorship mark
[scpubgit/File-Tree-Snapshot.git] / lib / File / Tree / Snapshot.pm
CommitLineData
cd8f4814 1# lots of this stuff was sponsored by socialflow.com
2
52185ab8 3package File::Tree::Snapshot;
4use Moo;
5use File::Path;
6use File::Basename;
7
8our $VERSION = '0.000001';
9$VERSION = eval $VERSION;
10
11has storage_path => (is => 'ro', required => 1);
12
13has allow_empty => (is => 'ro');
14
15sub file { join '/', (shift)->storage_path, @_}
16
17sub 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
28sub _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
38sub _exec {
39 my ($self, $cmd) = @_;
40 system($cmd) and die "Error during ($cmd)\n";
41 return 1;
42}
43
44sub _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
55sub create {
56 my ($self) = @_;
57 my $path = $self->storage_path;
58 $self->_mkpath($path);
59 $self->_git_exec('init');
60 return 1;
61}
62
63sub _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
70sub 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
85sub reset {
86 my ($self) = @_;
87 $self->_git_exec('add .');
88 $self->_git_exec('checkout -f');
89 return 1;
90}
91
92sub exists {
93 my ($self) = @_;
94 return -e join '/', $self->storage_path, '.git';
95}
96
97sub find_files {
98 my ($self, $ext, @path) = @_;
99 my $root = $self->file(@path);
100 my @files = `find $root -name '*.$ext' -type f`;
101 chomp @files;
102 return @files;
103}
104
1051;
ed0958d7 106
107=head1 NAME
108
109File::Tree::Snapshot - Snapshot files in a git repository
110
111=head1 SYNOPSIS
112
113 use File::Tree::Snapshot;
114
115 my $tree = File::Tree::Snapshot->new(
116 storage_path => '/path/to/tree',
117 );
118
119 $tree->create
120 unless $tree->exists;
121
122 # modify files, see methods below
123
124 $tree->commit;
125 # or
126 $tree->reset;
127
128=head1 DESCRIPTION
129
130This module manages snapshots of file system trees by wrapping the C<git>
131command line interface. It currently only manages generating the snapshots.
132
133The directories are standard Git repositories and can be accessed in the
134usual ways.
135
136=head1 ATTRIBUTES
137
138=head2 storage_path
139
140The path to the tree that should hold the files that are snapshot. This
141attribute is required.
142
143=head2 allow_empty
144
145If this attribute is set to true, commits will be created even if no changes
146were registered.
147
148=head1 METHODS
149
150=head2 new
151
152 my $tree = File::Tree::Snapshot->new(%attributes);
153
154Constructor. See L</ATTRIBUTES> for possible parameters.
155
156=head2 file
157
158 my $path = $tree->file(@relative_path_parts_to_file);
159
160Takes a set of path parts and returns the path to the file inside the
161storage.
162
163=head2 open
164
165 my $fh = $tree->open($mode, $file, %options);
166
167Opens a file within the storage. C<$mode> is passed straight to
168L<perlfunc/open>. The C<$file> is a relative path inside the storage.
169
170Possible options are:
171
172=over
173
174=item * C<is_absolute>
175
176If set to true the C<$file> will be assumed to already be an absolute
177path as returned by L</file>, instead of a path relative to the storage.
178
179=item * C<mkpath>
180
181Create the path to the file if it doesn't already exist.
182
183=back
184
185=head2 create
186
187 $tree->create;
188
189Create the directory (if it doesn't exist yet) and initialize it as a
190Git repository.
191
192=head2 exists
193
194 my $does_exist = $tree->exists;
195
196Returns true if the storage is an initialized Git repository.
197
198=head2 commit
199
200Will commit the changes made to the tree to the Git repository.
201
202=head2 reset
203
204Rolls back the changes since the last snapshot.
205
206=cut