lib/File/Tree/Snapshot.pm

   1 package File::Tree::Snapshot;
   2 use Moo;
   3 use File::Path;
   4 use File::Basename;
   5
   6 our $VERSION = '0.000001';
   7 $VERSION = eval $VERSION;
   8
   9 has storage_path => (is => 'ro', required => 1);
  10
  11 has allow_empty => (is => 'ro');
  12
  13 sub file { join '/', (shift)->storage_path, @_}
  14
  15 sub open {
  16     my ($self, $mode, $file, %opt) = @_;
  17     $file = $self->file($file)
  18         unless $opt{is_absolute};
  19     $self->_mkpath(dirname $file)
  20         if $opt{mkpath};
  21     open my $fh, $mode, $file
  22         or die "Unable to write '$file': $!\n";
  23     return $fh;
  24 }
  25
  26 sub _mkpath {
  27     my ($self, $dir) = @_;
  28     mkpath($dir, { error => \(my $err) });
  29     if (@$err) {
  30         warn "Error while attempting to create '$dir': $_\n"
  31             for map { (values %$_) } @$err;
  32     }
  33     return 1;
  34 }
  35
  36 sub _exec {
  37     my ($self, $cmd) = @_;
  38     system($cmd) and die "Error during ($cmd)\n";
  39     return 1;
  40 }
  41
  42 sub _git_exec {
  43     my ($self, @cmd) = @_;
  44     my $path = $self->storage_path;
  45     #local $ENV{GIT_DIR} = "$path/.git";
  46     return $self->_exec(
  47         sprintf q{cd %s && git %s},
  48             $path,
  49             join ' ', @cmd,
  50     );
  51 }
  52
  53 sub create {
  54     my ($self) = @_;
  55     my $path = $self->storage_path;
  56     $self->_mkpath($path);
  57     $self->_git_exec('init');
  58     return 1;
  59 }
  60
  61 sub _has_changes {
  62     my ($self) = @_;
  63     my $path = $self->storage_path;
  64     my @changes = `cd $path && git diff --name-only --cached`;
  65     return scalar @changes;
  66 }
  67
  68 sub commit {
  69     my ($self) = @_;
  70     $self->_git_exec('add .');
  71     unless ($self->_has_changes) {
  72         print "No changes\n";
  73         return 1;
  74     }
  75     $self->_git_exec('commit',
  76         '--all',
  77         ($self->allow_empty ? '--allow-empty' : ()),
  78         '-m' => sprintf('"Updated on %s"', scalar localtime),
  79     );
  80     return 1;
  81 }
  82
  83 sub reset {
  84     my ($self) = @_;
  85     $self->_git_exec('add .');
  86     $self->_git_exec('checkout -f');
  87     return 1;
  88 }
  89
  90 sub exists {
  91     my ($self) = @_;
  92     return -e join '/', $self->storage_path, '.git';
  93 }
  94
  95 sub find_files {
  96     my ($self, $ext, @path) = @_;
  97     my $root = $self->file(@path);
  98     my @files = `find $root -name '*.$ext' -type f`;
  99     chomp @files;
 100     return @files;
 101 }
 102
 103 1;
 104
 105 =head1 NAME
 106
 107 File::Tree::Snapshot - Snapshot files in a git repository
 108
 109 =head1 SYNOPSIS
 110
 111     use File::Tree::Snapshot;
 112
 113     my $tree = File::Tree::Snapshot->new(
 114         storage_path => '/path/to/tree',
 115     );
 116
 117     $tree->create
 118         unless $tree->exists;
 119
 120     # modify files, see methods below
 121
 122     $tree->commit;
 123     # or
 124     $tree->reset;
 125
 126 =head1 DESCRIPTION
 127
 128 This module manages snapshots of file system trees by wrapping the C<git>
 129 command line interface. It currently only manages generating the snapshots.
 130
 131 The directories are standard Git repositories and can be accessed in the
 132 usual ways.
 133
 134 =head1 ATTRIBUTES
 135
 136 =head2 storage_path
 137
 138 The path to the tree that should hold the files that are snapshot. This
 139 attribute is required.
 140
 141 =head2 allow_empty
 142
 143 If this attribute is set to true, commits will be created even if no changes
 144 were registered.
 145
 146 =head1 METHODS
 147
 148 =head2 new
 149
 150     my $tree = File::Tree::Snapshot->new(%attributes);
 151
 152 Constructor. See L</ATTRIBUTES> for possible parameters.
 153
 154 =head2 file
 155
 156     my $path = $tree->file(@relative_path_parts_to_file);
 157
 158 Takes a set of path parts and returns the path to the file inside the
 159 storage.
 160
 161 =head2 open
 162
 163     my $fh = $tree->open($mode, $file, %options);
 164
 165 Opens a file within the storage. C<$mode> is passed straight to
 166 L<perlfunc/open>. The C<$file> is a relative path inside the storage.
 167
 168 Possible options are:
 169
 170 =over
 171
 172 =item * C<is_absolute>
 173
 174 If set to true the C<$file> will be assumed to already be an absolute
 175 path as returned by L</file>, instead of a path relative to the storage.
 176
 177 =item * C<mkpath>
 178
 179 Create the path to the file if it doesn't already exist.
 180
 181 =back
 182
 183 =head2 create
 184
 185     $tree->create;
 186
 187 Create the directory (if it doesn't exist yet) and initialize it as a
 188 Git repository.
 189
 190 =head2 exists
 191
 192     my $does_exist = $tree->exists;
 193
 194 Returns true if the storage is an initialized Git repository.
 195
 196 =head2 commit
 197
 198 Will commit the changes made to the tree to the Git repository.
 199
 200 =head2 reset
 201
 202 Rolls back the changes since the last snapshot.
 203
 204 =cut