1 # lots of this stuff 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');
65 my $path = $self->storage_path;
66 my @changes = `cd $path && git diff --name-only --cached`;
67 return scalar @changes;
72 $self->_git_exec('add .');
73 unless ($self->_has_changes) {
77 $self->_git_exec('commit',
79 ($self->allow_empty ? '--allow-empty' : ()),
80 '-m' => sprintf('"Updated on %s"', scalar localtime),
87 $self->_git_exec('add .');
89 unless $self->_has_changes;
90 $self->_git_exec('checkout -f');
96 return -e join '/', $self->storage_path, '.git';
100 my ($self, $ext, @path) = @_;
101 my $root = $self->file(@path);
102 my @files = `find $root -name '*.$ext' -type f`;
111 File::Tree::Snapshot - Snapshot files in a git repository
115 use File::Tree::Snapshot;
117 my $tree = File::Tree::Snapshot->new(
118 storage_path => '/path/to/tree',
122 unless $tree->exists;
124 # modify files, see methods below
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.
135 The directories are standard Git repositories and can be accessed in the
142 The path to the tree that should hold the files that are snapshot. This
143 attribute is required.
147 If this attribute is set to true, commits will be created even if no changes
154 my $tree = File::Tree::Snapshot->new(%attributes);
156 Constructor. See L</ATTRIBUTES> for possible parameters.
160 my $path = $tree->file(@relative_path_parts_to_file);
162 Takes a set of path parts and returns the path to the file inside the
167 my $fh = $tree->open($mode, $file, %options);
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.
172 Possible options are:
176 =item * C<is_absolute>
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.
183 Create the path to the file if it doesn't already exist.
191 Create the directory (if it doesn't exist yet) and initialize it as a
196 my $does_exist = $tree->exists;
198 Returns true if the storage is an initialized Git repository.
202 Will commit the changes made to the tree to the Git repository.
206 Rolls back the changes since the last snapshot.
210 The development of this module was sponsored by L<http://socialflow.com/>.