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 $cmd = qq{cd $path && git diff --name-only --cached};
67 CORE::open my $handle, '-|', $cmd
68 or die "Unable to find changes in ($cmd): $!\n";
69 my @changes = <$handle>;
70 return scalar @changes;
75 $self->_git_exec('add .');
76 unless ($self->_has_changes) {
80 $self->_git_exec('commit',
82 ($self->allow_empty ? '--allow-empty' : ()),
83 '-m' => sprintf('"Updated on %s"', scalar localtime),
90 $self->_git_exec('add .');
92 unless $self->_has_changes;
93 $self->_git_exec('checkout -f');
99 return -e join '/', $self->storage_path, '.git';
103 my ($self, $ext, @path) = @_;
104 my $root = $self->file(@path);
105 my @files = `find $root -name '*.$ext' -type f`;
114 File::Tree::Snapshot - Snapshot files in a git repository
118 use File::Tree::Snapshot;
120 my $tree = File::Tree::Snapshot->new(
121 storage_path => '/path/to/tree',
125 unless $tree->exists;
127 # modify files, see methods below
135 This module manages snapshots of file system trees by wrapping the C<git>
136 command line interface. It currently only manages generating the snapshots.
138 The directories are standard Git repositories and can be accessed in the
145 The path to the tree that should hold the files that are snapshot. This
146 attribute is required.
150 If this attribute is set to true, commits will be created even if no changes
157 my $tree = File::Tree::Snapshot->new(%attributes);
159 Constructor. See L</ATTRIBUTES> for possible parameters.
163 my $path = $tree->file(@relative_path_parts_to_file);
165 Takes a set of path parts and returns the path to the file inside the
170 my $fh = $tree->open($mode, $file, %options);
172 Opens a file within the storage. C<$mode> is passed straight to
173 L<perlfunc/open>. The C<$file> is a relative path inside the storage.
175 Possible options are:
179 =item * C<is_absolute>
181 If set to true the C<$file> will be assumed to already be an absolute
182 path as returned by L</file>, instead of a path relative to the storage.
186 Create the path to the file if it doesn't already exist.
194 Create the directory (if it doesn't exist yet) and initialize it as a
199 my $does_exist = $tree->exists;
201 Returns true if the storage is an initialized Git repository.
205 Will commit the changes made to the tree to the Git repository.
209 Rolls back the changes since the last snapshot.
213 The development of this module was sponsored by L<http://socialflow.com/>.