view release on metacpan or  search on metacpan

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

use Carp ();
use Git::Libgit2 qw( init_lib check_rc GIT_REPOSITORY_INIT_BARE );
use Git::Libgit2::FFI ();
use Git::Native::Repository ();
use FFI::Platypus::Buffer qw( scalar_to_buffer );

use constant {
  GIT_CLONE_OPTIONS_VERSION => 1,
  # git_clone_options on libgit2 1.5 is ~312 bytes; over-allocate for
  # forward compat with newer libgit2 versions.
  CLONE_OPTIONS_SIZE        => 512,
};

# Ensure libgit2 is initialised before first use.
my $_init_count = 0;
sub _ensure_init {
  return if $_init_count;
  $_init_count = init_lib();
}

sub open {
  my ( $class, $path ) = @_;
  Carp::croak "Git::Native->open requires a path" unless defined $path;
  _ensure_init();
  my $repo;
  check_rc Git::Libgit2::FFI::git_repository_open( \$repo, $path );
  return Git::Native::Repository->new( _handle => $repo );
}

sub open_ext {
  my ( $class, $start_path, %opts ) = @_;
  _ensure_init();
  my $repo;
  check_rc Git::Libgit2::FFI::git_repository_open_ext(
    \$repo, $start_path,
    $opts{flags} // 0,
    $opts{ceiling_dirs},
  );
  return Git::Native::Repository->new( _handle => $repo );
}

sub init {
  my ( $class, $path, %opts ) = @_;
  Carp::croak "Git::Native->init requires a path" unless defined $path;
  _ensure_init();
  my $repo;
  my $flags = $opts{bare} ? GIT_REPOSITORY_INIT_BARE : 0;
  check_rc Git::Libgit2::FFI::git_repository_init( \$repo, $path, $flags );
  my $r = Git::Native::Repository->new( _handle => $repo );
  # Pin HEAD at the requested branch regardless of the compiled-in default
  # or ambient init.defaultBranch (sterile CI containers default to
  # 'master'). The branch may be unborn at this point - that's fine.
  if ( defined( my $branch = $opts{initial_branch} ) ) {
    $branch = "refs/heads/$branch" unless $branch =~ m{^refs/};
    $r->set_head($branch);
  }
  return $r;
}

# clone($url, $local_path) - non-bare only for now.
# Auth via credentials => sub {...} not yet plumbed; the clone_options
# struct embeds a fetch_options whose callback offset we'd need to probe
# per libgit2 version. Bare clones go through init+fetch+HEAD instead -
# the offset of `bare` is past two large embedded structs and isn't
# stable across libgit2 versions worth pinning here.
sub clone {
  my ( $class, $url, $local_path, %opts ) = @_;
  Carp::croak "Git::Native->clone requires url and local_path"
    unless defined $url && defined $local_path;
  Carp::croak "bare clones not yet supported by Git::Native->clone - use init(bare=>1) + remote + fetch"
    if $opts{bare};
  _ensure_init();

  my $buf = "\0" x CLONE_OPTIONS_SIZE;
  my ($buf_p) = scalar_to_buffer($buf);
  check_rc Git::Libgit2::FFI::git_clone_options_init( $buf_p, GIT_CLONE_OPTIONS_VERSION );

  my $repo;
  check_rc Git::Libgit2::FFI::git_clone( \$repo, $url, $local_path, $buf_p );
  return Git::Native::Repository->new( _handle => $repo );
}

# reference_name_is_valid($name) - does libgit2 accept this refname?
# No repository required. Returns 1 (valid) or 0 (invalid).
sub reference_name_is_valid {
  my ( $class, $name ) = @_;
  return 0 unless defined $name;
  _ensure_init();
  my $rc = Git::Libgit2::FFI::git_reference_name_is_valid( \my $valid, $name );
  return ( $rc == 0 && $valid ) ? 1 : 0;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Git::Native - Native Git for Perl via libgit2 (FFI, no fork/exec)

=head1 VERSION

version 0.003

=head1 SYNOPSIS

  use Git::Native;

  my $repo = Git::Native->open('/path/to/.git');
  my $main = $repo->reference('refs/heads/main');
  say $main->target;     # commit OID

  # Build a commit without forking git
  my $blob_oid = $repo->blob_create_frombuffer("hello\n");
  my $tb       = $repo->tree_builder;
  $tb->insert(name => 'hi.txt', oid => $blob_oid, mode => 0100644);
  my $tree_oid = $tb->write;