1 # most of this was sponsored by socialflow.com
3 package File::Tree::Snapshot;
8 our $VERSION = '0.000001';
9 $VERSION = eval $VERSION;
11 has storage_path => (is => 'ro', required => 1);
13 has allow_empty => (is => 'ro');
15 sub file { join '/', (shift)->storage_path, @_}
18 my ($self, $mode, $file, %opt) = @_;
19 $file = $self->file($file)
20 unless $opt{is_absolute};
21 $self->_mkpath(dirname $file)
23 open my $fh, $mode, $file
24 or die "Unable to write '$file': $!\n";
29 my ($self, $dir) = @_;
30 mkpath($dir, { error => \(my $err) });
32 warn "Error while attempting to create '$dir': $_\n"
33 for map { (values %$_) } @$err;
39 my ($self, $cmd) = @_;
40 system($cmd) and die "Error during ($cmd)\n";
45 my ($self, @cmd) = @_;
46 my $path = $self->storage_path;
47 #local $ENV{GIT_DIR} = "$path/.git";
49 sprintf q{cd %s && git %s},
57 my $path = $self->storage_path;
58 $self->_mkpath($path);
59 $self->_git_exec('init');
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"');
69 my $path = $self->storage_path;
70 my $cmd = qq{cd $path && git status --porcelain};
71 CORE::open my $handle, '-|', $cmd
72 or die "Unable to find changes in ($cmd): $!\n";
73 my @changes = <$handle>;
74 return scalar @changes;
79 $self->_git_exec('add .');
80 unless ($self->_has_changes) {
84 $self->_git_exec('commit',
86 ($self->allow_empty ? '--allow-empty' : ()),
87 '-m' => sprintf('"Updated on %s"', scalar localtime),
94 $self->_git_exec('add .');
96 unless $self->_has_changes;
97 $self->_git_exec('checkout -f');
103 return -e join '/', $self->storage_path, '.git';
107 my ($self, $ext, @path) = @_;
108 my $root = $self->file(@path);
109 my @files = `find $root -name '*.$ext' -type f`;
118 File::Tree::Snapshot - Snapshot files in a git repository
122 use File::Tree::Snapshot;
124 my $tree = File::Tree::Snapshot->new(
125 storage_path => '/path/to/tree',
129 unless $tree->exists;
131 # modify files, see methods below
139 This module manages snapshots of file system trees by wrapping the C<git>
140 command line interface. It currently only manages generating the snapshots.
142 The directories are standard Git repositories and can be accessed in the
149 The path to the tree that should hold the files that are snapshot. This
150 attribute is required.
154 If this attribute is set to true, commits will be created even if no changes
161 my $tree = File::Tree::Snapshot->new(%attributes);
163 Constructor. See L</ATTRIBUTES> for possible parameters.
167 my $path = $tree->file(@relative_path_parts_to_file);
169 Takes a set of path parts and returns the path to the file inside the
174 my $fh = $tree->open($mode, $file, %options);
176 Opens a file within the storage. C<$mode> is passed straight to
177 L<perlfunc/open>. The C<$file> is a relative path inside the storage.
179 Possible options are:
183 =item * C<is_absolute>
185 If set to true the C<$file> will be assumed to already be an absolute
186 path as returned by L</file>, instead of a path relative to the storage.
190 Create the path to the file if it doesn't already exist.
198 Create the directory (if it doesn't exist yet) and initialize it as a
203 my $does_exist = $tree->exists;
205 Returns true if the storage is an initialized Git repository.
209 Will commit the changes made to the tree to the Git repository.
213 Rolls back the changes since the last snapshot.
217 phaylon - Robert Sedlacek (cpan:PHAYLON) <r.sedlacek@shadowcat.co.uk>
221 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
225 The development of this module was sponsored by L<http://socialflow.com/>.
229 Copyright (c) 2012 the File::Tree::Snapshot L</AUTHOR>, L</CONTRIBUTORS>
230 and L</SPONSORS> as listed above.
234 This library is free software and may be distributed under the same terms