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