view release on metacpan or  search on metacpan

lib/Git/PurePerl.pm  view on Meta::CPAN

            sha1    => $sha1,
            kind    => $kind,
            size    => $size,
            content => $content,
            git     => $self,
        );
    } elsif ( $kind eq 'blob' ) {
        return Git::PurePerl::Object::Blob->new(
            sha1    => $sha1,
            kind    => $kind,
            size    => $size,
            content => $content,
            git     => $self,
        );
    } elsif ( $kind eq 'tag' ) {
        return Git::PurePerl::Object::Tag->new(
            sha1    => $sha1,
            kind    => $kind,
            size    => $size,
            content => $content,
            git     => $self,
        );
    } else {
        confess "unknown kind $kind: $content";
    }
}

sub all_sha1s {
    my $self = shift;
    my $dir = dir( $self->gitdir, 'objects' );

    my @streams;
    push @streams, $self->loose->all_sha1s;

    foreach my $pack ( $self->packs ) {
        push @streams, $pack->all_sha1s;
    }

    return Data::Stream::Bulk::Cat->new( streams => \@streams );
}

sub all_objects {
    my $self   = shift;
    my $stream = $self->all_sha1s;
    return Data::Stream::Bulk::Filter->new(
        filter => sub { return [ $self->get_objects(@$_) ] },
        stream => $stream,
    );
}

sub put_object {
    my ( $self, $object, $ref ) = @_;
    $self->loose->put_object($object);

    if ( $object->kind eq 'commit' ) {
        $ref = 'master' unless $ref;
        $self->update_ref( $ref, $object->sha1 );
    }
}

sub update_ref {
    my ( $self, $refname, $sha1 ) = @_;
    my $ref = file( $self->gitdir, 'refs', 'heads', $refname );
    $ref->parent->mkpath;
    my $ref_fh = $ref->openw;
    $ref_fh->print($sha1) || die "Error writing to $ref";

    # FIXME is this always what we want?
    my $head = file( $self->gitdir, 'HEAD' );
    my $head_fh = $head->openw;
    $head_fh->print("ref: refs/heads/$refname")
        || die "Error writing to $head";
}

sub init {
    my ( $class, %arguments ) = @_;

    my $directory = $arguments{directory};
    my $git_dir;

    unless ( defined $directory ) {
        $git_dir = $arguments{gitdir}
            || confess
            "init() needs either a 'directory' or a 'gitdir' argument";
    } else {
        if ( not defined $arguments{gitdir} ) {
            $git_dir = $arguments{gitdir} = dir( $directory, '.git' );
        }
        dir($directory)->mkpath;
    }

    dir($git_dir)->mkpath;
    dir( $git_dir, 'refs',    'tags' )->mkpath;
    dir( $git_dir, 'objects', 'info' )->mkpath;
    dir( $git_dir, 'objects', 'pack' )->mkpath;
    dir( $git_dir, 'branches' )->mkpath;
    dir( $git_dir, 'hooks' )->mkpath;

    my $bare = defined($directory) ? 'false' : 'true';
    $class->_add_file(
        file( $git_dir, 'config' ),
        "[core]\n\trepositoryformatversion = 0\n\tfilemode = true\n\tbare = $bare\n\tlogallrefupdates = true\n"
    );
    $class->_add_file( file( $git_dir, 'description' ),
        "Unnamed repository; edit this file to name it for gitweb.\n" );
    $class->_add_file(
        file( $git_dir, 'hooks', 'applypatch-msg' ),
        "# add shell script and make executable to enable\n"
    );
    $class->_add_file( file( $git_dir, 'hooks', 'post-commit' ),
        "# add shell script and make executable to enable\n" );
    $class->_add_file(
        file( $git_dir, 'hooks', 'post-receive' ),
        "# add shell script and make executable to enable\n"
    );
    $class->_add_file( file( $git_dir, 'hooks', 'post-update' ),
        "# add shell script and make executable to enable\n" );
    $class->_add_file(
        file( $git_dir, 'hooks', 'pre-applypatch' ),
        "# add shell script and make executable to enable\n"
    );