File Coverage

File:lib/Yukki/Model/Repository.pm
Coverage:29.6%

linestmtbrancondsubpodtimecode
1package Yukki::Model::Repository;
2
3
2
2
937
7
use v5.24;
4
2
2
2
7
4
13
use utf8;
5
2
2
2
23
2
15
use Moo;
6
7extends 'Yukki::Model';
8
9
2
2
2
467
4
18
use Yukki::Error qw( http_throw );
10
2
2
2
874
3
34
use Yukki::Model::File;
11
12
2
2
2
688
612031
45
use DateTime::Format::Mail;
13
2
2
2
510
14526
8
use Git::Repository v1.18;
14
2
2
2
40
4
13
use Type::Utils;
15
2
2
2
1942
3
22
use Types::Path::Tiny qw( Path );
16
2
2
2
497
4
7
use Types::Standard qw( Str );
17
2
2
2
846
2
55
use Try::Tiny;
18
19
2
2
2
6
2
6
use namespace::clean;
20
21# ABSTRACT: model for accessing objects in a git repository
22
23 - 46
=head1 SYNOPSIS

  my $repository = $app->model('Repository', { name => 'main' });
  my $file = $repository->file({ path => 'foo.yukki' });

=head1 DESCRIPTION

This model contains methods for performing all the individual operations
required to store files into and fetch files from the git repository. It
includes tools for building trees, commiting, creating blobs, fetching file
lists, etc.

=head1 EXTENDS

L<Yukki::Model>

=head1 ATTRIBUTES

=head2 name

This is the name of the repository. This is used to lookup the configuration for
the repository from the F<yukki.conf>.

=cut
47
48has name => (
49    is          => 'ro',
50    isa         => Str,
51    required    => 1,
52);
53
54 - 60
=head2 repository_settings

These are the settings telling this model where to find the git repository and
how to access it. It is loaded automatically using the L</name> to look up
information in the F<yukki.conf>.

=cut
61
62has repository_settings => (
63    is          => 'ro',
64    isa         => class_type('Yukki::Settings::Repository'),
65    required    => 1,
66    lazy        => 1,
67    default     => sub {
68        my $self = shift;
69        my $repo_config = $self->app->settings->repositories->{$self->name};
70
71        if (!$repo_config) {
72            my $file = $self->app->locate('repo_path', $self->name);
73            $repo_config = Yukki::Settings::Repository->load_yaml(
74                $file->slurp_utf8
75            );
76        }
77
78        return $repo_config;
79    },
80    handles     => {
81        'title'  => 'name',
82        'branch' => 'site_branch',
83    },
84);
85
86 - 91
=head2 repository_path

This is the path to the repository. It is located using the C<repository_path>
and C<repository> keys in the configuration.

=cut
92
93has repository_path => (
94    is          => 'ro',
95    isa         => Path,
96    coerce      => 1,
97    required    => 1,
98    lazy        => 1,
99    builder     => '_build_repository_path',
100);
101
102sub _build_repository_path {
103
2
29
    my $self = shift;
104
105
2
26
    my $repo_settings = $self->repository_settings;
106
2
44
    return $self->locate_dir('repository_path', $repo_settings->repository);
107}
108
109 - 113
=head2 git

This is a L<Git::Repository> object which helps us do the real work.

=cut
114
115has git => (
116    is          => 'ro',
117    isa         => class_type('Git::Repository'),
118    required    => 1,
119    lazy        => 1,
120    builder     => '_build_git',
121);
122
123sub _build_git {
124
2
15
    my $self = shift;
125
2
25
    return Git::Repository->new( git_dir => $self->repository_path );
126}
127
128 - 137
=head1 METHODS

=head2 author_name

This is the author name to use when making changes to the repository.

This is taken from the C<author_name> of the C<anonymous> key in the
configuration or defaults to "Anonymous".

=cut
138
139
1
1
54
sub author_name { shift->app->settings->anonymous->author_name }
140
141 - 148
=head2 author_email

This is the author email to use when making changes to the repository.

This is taken from teh C<author_email> of the C<anonymous> key in the
configuration or defaults to "anonymous@localhost".

=cut
149
150
1
1
49
sub author_email { shift->app->settings->anonymous->author_email }
151
152 - 189
=head2 make_tree

  my $tree_id = $repository->make_tree($old_tree_id, \@parts, $object_id);
  my $tree_id = $repository->make_tree($old_tree_id, \@parts);
  my $tree_id = $repository->make_tree(
      $old_tree_id, \@old_parts, \@new_parts, $object_id);

In any case described here, the method returns the object ID of the top level
tree created.

=head3 Insert/Update

When C<$object_id> is given, this will construct one or more trees in the git
repository to place the C<$object_id> into the deepest tree. This starts by
reading the tree found using the object ID in C<$old_tree_id>. The first path
part in C<@parts> is shifted off. If an existing path is found there, that
path will be replaced. If not, a new path will be added. A tree object will be
constructed for all byt he final path part in C<@parts>.

When the final part is reached, that path will be placed into the final tree
as a blob using the given C<$object_id>.

This method will fail if it runs into a situation where a blob would be
replaced by a tree or a tree would be replaced by a blob.

=head3 Remove

When C<$object_id> is not passed or C<undef>, this will cause the final tree or blob found to be removed. This works essentially the same as the case for storing a blob, but when it gets to the last tree or blob found, it will elide that name from the final tree constructed.

This method will fail if you attempt to remove something that does not exist.

=head3 Rename

When a second array reference is passed with the C<$object_id>, this method will perform a rename. In this case, the method will remove the path named in the L<@old_parts> and add the path named in <@new_parts> using the given C<$object_id> at that new location.

This method will fail if a failure condition that would occur during either the insert/update or remove operation that is being performed simultaneously.

=cut
190
191sub make_tree {
192
0
1
0
    my $self = shift;
193
0
0
    my $base = shift;
194
0
0
    my $path = shift;
195
196
0
0
    my (@new_path, @old_path, $blob);
197
198    # This is a rename
199
0
0
    if (ref $_[0]) {
200
0
0
        my $new_path = shift;
201
0
0
        $blob        = shift;
202
0
0
        @new_path    = @$new_path;
203
0
0
        @old_path    = @$path;
204    }
205
206    # Otherwise it's a store or delete
207    else {
208
0
0
        $blob = shift;
209
210        # Defined $blob -> Store
211
0
0
        if (defined $blob) {
212
0
0
            @new_path = @$path;
213        }
214
215        # Undefined $blob -> delete
216        else {
217
0
0
            @old_path = @$path;
218        }
219    }
220
221
0
0
    my ($new_mode, $new_type, $new_name, $old_name, $remove_here);
222
223    # Parts to add or update
224
0
0
    if (@new_path) {
225
0
0
        $new_name = shift @new_path;
226
227        # Create the file here?
228
0
0
        if (@new_path == 0) {
229
0
0
            $new_mode = '100644';
230
0
0
            $new_type = 'blob';
231        }
232
233        # Or we're still hunting down the tree
234        else {
235
0
0
            $new_mode = '040000';
236
0
0
            $new_type = 'tree';
237        }
238    }
239
240    # Parts to remove
241
0
0
    if (@old_path) {
242
0
0
        $old_name    = shift @old_path;
243
0
0
        $remove_here = (@old_path == 0);
244    }
245
246
0
0
    my $git = $self->git;
247
248
0
0
    my $overwrite;
249    my @new_tree;
250
0
0
    if (defined $base) {
251
0
0
        my @old_tree = $git->run('ls-tree', $base);
252
0
0
        for my $line (@old_tree) {
253
0
0
            my ($old_mode, $old_type, $old_object_id, $old_file) = split /\s+/, $line, 4;
254
255
0
0
            if (defined $new_name and $old_file eq $new_name) {
256
257                # The file already exists, we are doing an update
258
0
0
                $overwrite++;
259
260                # Cannot overwrite a file with a dir or a dir with a file
261
0
0
                http_throw("cannot replace $old_type $new_name with $new_type")
262                    if $old_type ne $new_type;
263
264
265                # Add the updated file to the tree
266
0
0
                if ($new_type eq 'blob') {
267
0
0
                    push @new_tree, "$new_mode $new_type $blob\t$new_name";
268                }
269
270                # The child tree contains both sides of the rename
271                elsif ($old_name eq $new_name) {
272
0
0
                    my $tree_id = $self->make_tree($old_object_id, \@old_path, \@new_path, $blob);
273
0
0
                    push @new_tree, "$new_mode $new_type $tree_id\t$new_name";
274                }
275
276                # Add the updated tree contains only the rename/add
277                else {
278
0
0
                    my $tree_id = $self->make_tree($old_object_id, \@new_path, $blob);
279
0
0
                    push @new_tree, "$new_mode $new_type $tree_id\t$new_name";
280                }
281            }
282
283            # If $old_name != $new_name and it matches this file
284            elsif (defined $old_name and $old_file eq $old_name) {
285
286                # if ($remove_here) { ... do nothing ... }. The file will be
287                # omitted. \o/
288
289                # Not yet removed, but we need to hunt it down and remove it
290
0
0
                unless ($remove_here) {
291
0
0
                    my $tree_id = $self->make_tree($old_object_id, \@old_path);
292
0
0
                    push @new_tree, "040000 tree $tree_id\t$old_name";
293                }
294            }
295
296            # It's something else, leave it be.
297            else {
298
0
0
                push @new_tree, $line;
299            }
300        }
301    }
302
303    # If the file or tree we want to create was never encountered, add it
304
0
0
    if ($new_name and not $overwrite) {
305
306        # ...as a file
307
0
0
        if ($new_type eq 'blob') {
308
0
0
            push @new_tree, "$new_mode $new_type $blob\t$new_name";
309        }
310
311        # ...as a tree
312        else {
313
0
0
            my $tree_id = $self->make_tree(undef, \@new_path, $blob);
314
0
0
            push @new_tree, "$new_mode $new_type $tree_id\t$new_name";
315        }
316    }
317
318    # Now, build this new tree from the input we've generated
319
0
0
    return $git->run('mktree', { input => join "\n", @new_tree });
320}
321
322 - 329
=head2 make_blob

  my $object_id = $repository->make_blob($name, $content);

This creates a new file blob in the git repository with the given name and the
file contents.

=cut
330
331sub make_blob {
332
0
1
0
    my ($self, $name, $content) = @_;
333
334
0
0
    return $self->git->run('hash-object', '-t', 'blob', '-w', '--stdin', '--path', $name,
335        { input => $content });
336}
337
338 - 345
=head2 make_blob_from_file

  my $object_id = $repository->make_blob_from_file($name, $filename);

This is identical to L</make_blob>, except that the contents are read from the
given filename on the local disk.

=cut
346
347sub make_blob_from_file {
348
0
1
0
    my ($self, $name, $filename) = @_;
349
350
0
0
    return $self->git->run('hash-object', '-t', 'blob', '-w', '--path', $name, $filename);
351}
352
353 - 359
=head2 find_root

  my $tree_id = $repository->find_root;

This returns the object ID for the tree at the root of the L</branch>.

=cut
360
361sub find_root {
362
0
1
0
    my ($self) = @_;
363
364
0
0
    my $old_tree_id;
365
0
0
    my @ref_info = $self->git->run('show-ref', $self->branch);
366
0
0
    REF: for my $line (@ref_info) {
367
0
0
        my ($object_id, $name) = split /\s+/, $line, 2;
368
369
0
0
        if ($name eq $self->branch) {
370
0
0
            $old_tree_id = $object_id;
371
0
0
            last REF;
372        }
373    }
374
375
0
0
    return $old_tree_id;
376}
377
378 - 388
=head2 commit_tree

  my $commit_id = $self->commit_tree($old_tree_id, $new_tree_id, $comment);

This takes an existing tree commit (generally found with L</find_root>), a new
tree to replace it (generally constructed by L</make_tree>) and creates a
commit using the given comment.

The object ID of the committed ID is returned.

=cut
389
390sub commit_tree {
391
0
1
0
    my ($self, $old_tree_id, $new_tree_id, $comment) = @_;
392
393
0
0
    return $self->git->run(
394        'commit-tree', $new_tree_id, '-p', $old_tree_id, {
395            input => $comment,
396            env   => {
397                GIT_AUTHOR_NAME  => $self->author_name,
398                GIT_AUTHOR_EMAIL => $self->author_email,
399            },
400        },
401    );
402}
403
404 - 412
=head2 update_root

  $self->update_root($old_tree_id, $new_tree_id);

Given an old commit ID and a new commit ID, this moves the HEAD of the
L</branch> so that it points to the new commit. This is called after
L</commit_tree> has setup the commit.

=cut
413
414sub update_root {
415
0
1
0
    my ($self, $old_commit_id, $new_commit_id) = @_;
416
0
0
    $self->git->command('update-ref', $self->branch, $new_commit_id, $old_commit_id);
417}
418
419 - 426
=head2 find_path

  my $object_id = $self->find_path($path);

Given a path within the repository, this will find the object ID of that tree or
blob at that path for the L</branch>.

=cut
427
428sub find_path {
429
3
1
65
    my ($self, $path) = @_;
430
431
3
4
    my $object_id;
432    my @files;
433    try {
434
3
157
        @files = $self->git->run('ls-tree', $self->branch, $path);
435    }
436    catch {
437
438        # Looks like an empty repo, try initializing it
439
0
0
        if ($_ =~ /Not a valid object name/) {
440
0
0
            $self->initialize_repository;
441
0
0
            @files = $self->git->run('ls-tree', $self->branch, $path);
442        }
443
444        # I don't know what this is, die die die!
445        else {
446
0
0
            die $_;
447        }
448
3
22
    };
449
450
3
87972
    FILE: for my $line (@files) {
451
3
34
        my ($mode, $type, $id, $name) = split /\s+/, $line, 4;
452
453
3
21
        if ($name eq $path) {
454
3
9
            $object_id = $id;
455
3
9
            last FILE;
456        }
457    }
458
459
3
41
    return $object_id;
460}
461
462 - 468
=head2 show

  my $content = $repository->show($object_id);

Returns the contents of the blob for the given object ID.

=cut
469
470sub show {
471
2
1
62
    my ($self, $object_id) = @_;
472
2
40
    return $self->git->run('show', $object_id);
473}
474
475 - 481
=head2 fetch_size

  my $bytes = $repository->fetch_size($path);

Returns the size, in bites, of the blob at the given path.

=cut
482
483sub fetch_size {
484
0
1
0
    my ($self, $path) = @_;
485
486
0
0
    my @files = $self->git->run('ls-tree', '-l', $self->branch, $path);
487
0
0
    FILE: for my $line (@files) {
488
0
0
        my ($mode, $type, $id, $size, $name) = split /\s+/, $line, 5;
489
0
0
        return $size if $name eq $path;
490    }
491
492
0
0
    return;
493}
494
495 - 502
=head2 list_files

  my @files = $repository->list_files($path);

Returns a list of L<Yukki::Model::File> objects for all the files found at
C<$path> in the repository.

=cut
503
504sub list_files {
505
0
1
0
    my ($self, $path) = @_;
506
0
0
    my @files;
507
508
0
0
    my @tree_files = $self->git->run('ls-tree', $self->branch, $path . '/');
509
0
0
    FILE: for my $line (@tree_files) {
510
0
0
        my ($mode, $type, $id, $name) = split /\s+/, $line, 4;
511
512
0
0
        next unless $type eq 'blob';
513
514
0
0
        my $filetype;
515
0
0
        if ($name =~ s/\.(?<filetype>[a-z0-9]+)$//) {
516
0
0
            $filetype = $+{filetype};
517        }
518
519
0
0
        push @files, $self->file({ path => $name, filetype => $filetype });
520    }
521
522
0
0
    return @files;
523}
524
525 - 531
=head2 file

  my $file = $repository->file({ path => 'foo', filetype => 'yukki' });

Returns a single L<Yukki::Model::File> object for the given path and filetype.

=cut
532
533sub file {
534
1
1
2
    my ($self, $params) = @_;
535
536
1
9
    Yukki::Model::File->new(
537        %$params,
538        app        => $self->app,
539        repository => $self,
540    );
541}
542
543 - 549
=head2 default_file

  my $file = $repository->default_file;

Return the default L<Yukki::Model::File> configured for this repository.

=cut
550
551sub default_file {
552
0
1
    my $self = shift;
553
554
0
    return Yukki::Model::File->new(
555        full_path  => $self->repository_settings->default_page,
556        app        => $self->app,
557        repository => $self,
558    );
559}
560
561 - 599
=head2 log

  my @log = $repository->log( full_path => 'foo.yukk' );

Returns a list of revisions. Each revision is a hash with the following keys:

=over

=item object_id

The object ID of the commit.

=item author_name

The name of the commti author.

=item date

The date the commit was made.

=item time_ago

A string showing how long ago the edit took place.

=item comment

The comment the author made about the comment.

=item lines_added

Number of lines added.

=item lines_removed

Number of lines removed.

=back

=cut
600
601sub log {
602
0
1
    my ($self, $full_path) = @_;
603
604
0
    my @lines = $self->git->run(
605        'log', $self->branch, '--pretty=format:%H~%an~%aD~%ar~%s', '--numstat',
606        '--', $full_path
607    );
608
609
0
    my @revisions;
610    my $current_revision;
611
612
0
    my $mode = 'log';
613
0
    for my $line (@lines) {
614
615        # First line is the log line
616
0
        if ($mode eq 'log') {
617
0
            $current_revision = {};
618
619
0
0
            @{ $current_revision }{qw( object_id author_name date time_ago comment )}
620                = split /~/, $line, 5;
621
622            $current_revision->{date} = DateTime::Format::Mail->parse_datetime(
623                $current_revision->{date}
624
0
            );
625
626
0
            $mode = 'stat';
627        }
628
629        # Remaining lines are the numstat
630        elsif ($mode eq 'stat') {
631
0
            my ($added, $removed, $path) = split /\s+/, $line, 3;
632
0
            if ($path eq $full_path) {
633
0
                $current_revision->{lines_added}   = $added;
634
0
                $current_revision->{lines_removed} = $removed;
635            }
636
637
0
            $mode = 'skip';
638        }
639
640        # Once we know the numstat, search for the blank and start over
641        elsif ($mode eq 'skip') {
642
0
            push @revisions, $current_revision;
643
0
            $mode = 'log' if $line !~ /\S/;
644        }
645
646        else {
647
0
            http_throw("invalid parse mode '$mode'");
648        }
649    }
650
651
0
    return @revisions;
652}
653
654 - 666
=head2 diff_blobs

  my @chunks = $self->diff_blobs('file.yukki', 'a939fe...', 'b7763d...');

Given a file path and two object IDs, returns a list of chunks showing the difference between to revisions of that path. Each chunk is a two element array. The first element is the type of chunk and the second is any detail for that chunk.

The types are:

    "+"    This chunk was added to the second revision.
    "-"    This chunk was removed in the second revision.
    " "    This chunk is the same in both revisions.

=cut
667
668sub diff_blobs {
669
0
1
    my ($self, $path, $object_id_1, $object_id_2) = @_;
670
671
0
    my @lines = $self->git->run(
672        'diff', '--word-diff=porcelain', '--unified=10000000', '--patience',
673        $object_id_1, $object_id_2, '--', $path,
674    );
675
676
0
    my @chunks;
677
0
    my $last_chunk_type = '';
678
679
0
    my $i = 0;
680
0
    LINE: for my $line (@lines) {
681
0
        next if $i++ < 5;
682
683
0
        my ($type, $detail) = $line =~ /^(.)(.*)$/;
684
0
        if ($type =~ /^(?:~| |\+|-)$/) {
685
0
            if ($last_chunk_type eq $type) {
686
0
                $chunks[-1][1] .= $detail;
687            }
688            elsif ($type eq '~') {
689
0
                $chunks[-1][1] .= "\n";
690            }
691            else {
692
0
                push @chunks, [ $type, $detail ];
693
0
                $last_chunk_type = $type;
694            }
695        }
696        elsif ($type eq '\\') { }
697
0
        else { warn "unknown diff line type $type" }
698    }
699
700
0
    return @chunks;
701}
702
703 - 709
=head2 initialize_repository

  $self->initialize_repository;

Run on an empty repository to create an empty one.

=cut
710
711sub initialize_repository {
712
0
1
    my $self = shift;
713
714
0
    my $repository_path = ''.$self->repository_path;
715
0
    Git::Repository->run('init', '--bare', $repository_path);
716
717    # TODO This would be nice to have as a config.
718
0
    my $title  = $self->repository_settings->name // 'Untitled';
719
0
    my $stub_main = <<END_OF_STUB_MAIN;
720# $title
721
722Welcome to your new wiki repository. The first thing you will probably
723want to do is edit this page.
724
725Cheers.
726
727END_OF_STUB_MAIN
728
729
0
    my $page = $self->repository_settings->default_page;
730
0
    my $object_id = $self->git->run('hash-object', '-t', 'blob', '-w', '--stdin', "--path=$page", { input => $stub_main });
731
732
0
    my $stub_tree = "100655 blob $object_id\t$page\n";
733
0
    my $tree_id   = $self->git->run('mktree', { input => $stub_tree });
734
0
    my $commit_id = $self->git->run('commit-tree', $tree_id, {
735        input => 'Initializing empty Yukki repository.',
736        env   => {
737            GIT_AUTHOR_NAME  => 'Yukki::Model::Repository',
738            GIT_AUTHOR_EMAIL => 'hanenkamp@cpan.org',
739        },
740    });
741
742
0
    my $branch = $self->branch;
743
0
    $self->git->run('update-ref', $branch, $commit_id, '0' x 40);
744
745
0
    return;
746}
747
748 - 754
=head2 clone_repository

    $self->clone_repository($origin);

Given a remote repository URI to clone from in C<$origin>, initialize the local repository from a clone of the remote one.

=cut
755
756sub clone_repository {
757
0
1
    my ($self, $origin) = @_;
758
759
0
    my $repository_path = ''.$self->repository_path;
760
0
    Git::Repository->run('clone', '--bare', $origin, $repository_path);
761
762
0
    return;
763}
764
7651;