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 .');
88 $self->_git_exec('checkout -f');
94 return -e join '/', $self->storage_path, '.git';
98 my ($self, $ext, @path) = @_;
99 my $root = $self->file(@path);
100 my @files = `find $root -name '*.$ext' -type f`;
109 File::Tree::Snapshot - Snapshot files in a git repository
113 use File::Tree::Snapshot;
115 my $tree = File::Tree::Snapshot->new(
116 storage_path => '/path/to/tree',
120 unless $tree->exists;
122 # modify files, see methods below
130 This module manages snapshots of file system trees by wrapping the C<git>
131 command line interface. It currently only manages generating the snapshots.
133 The directories are standard Git repositories and can be accessed in the
140 The path to the tree that should hold the files that are snapshot. This
141 attribute is required.
145 If this attribute is set to true, commits will be created even if no changes
152 my $tree = File::Tree::Snapshot->new(%attributes);
154 Constructor. See L</ATTRIBUTES> for possible parameters.
158 my $path = $tree->file(@relative_path_parts_to_file);
160 Takes a set of path parts and returns the path to the file inside the
165 my $fh = $tree->open($mode, $file, %options);
167 Opens a file within the storage. C<$mode> is passed straight to
168 L<perlfunc/open>. The C<$file> is a relative path inside the storage.
170 Possible options are:
174 =item * C<is_absolute>
176 If set to true the C<$file> will be assumed to already be an absolute
177 path as returned by L</file>, instead of a path relative to the storage.
181 Create the path to the file if it doesn't already exist.
189 Create the directory (if it doesn't exist yet) and initialize it as a
194 my $does_exist = $tree->exists;
196 Returns true if the storage is an initialized Git repository.
200 Will commit the changes made to the tree to the Git repository.
204 Rolls back the changes since the last snapshot.