1 contributor
package Gitprep::Git;
use Mojo::Base -base;
use Carp 'croak';
use File::Find 'find';
use File::Basename qw/basename dirname/;
use Fcntl ':mode';
# Encode
use Encode qw/encode decode/;
sub enc {
my ($self, $str) = @_;
my $enc = $self->encoding;
return encode($enc, $str);
}
sub dec {
my ($self, $str) = @_;
my $enc = $self->encoding;
my $new_str;
eval { $new_str = decode($enc, $str) };
return $@ ? $str : $new_str;
}
# Attributes
has 'bin';
has 'search_dirs';
has 'search_max_depth';
has 'encoding';
has 'text_exts';
sub blob_mimetype {
my ($self, $fh, $file) = @_;
return 'text/plain' unless $fh;
# MIME type
my $text_exts = $self->text_exts;
for my $text_ext (@$text_exts) {
my $ext = quotemeta($text_ext);
return 'text/plain' if $file =~ /\.$ext$/i;
}
if (-T $fh) { return 'text/plain' }
elsif (! $file) { return 'application/octet-stream' }
elsif ($file =~ m/\.png$/i) { return 'image/png' }
elsif ($file =~ m/\.gif$/i) { return 'image/gif' }
elsif ($file =~ m/\.jpe?g$/i) { return 'image/jpeg'}
else { return 'application/octet-stream'}
return;
}
sub blob_contenttype {
my ($self, $fh, $file, $type) = @_;
# Content type
$type ||= $self->blob_mimetype($fh, $file);
if ($type eq 'text/plain') {
$type .= "; charset=" . $self->encoding;
}
return $type;
}
sub check_head_link {
my ($self, $dir) = @_;
# Chack head
my $head_file = "$dir/HEAD";
return ((-e $head_file) ||
(-l $head_file && readlink($head_file) =~ /^refs\/heads\//));
}
sub cmd {
my ($self, $project) = @_;
# Execute git command
return ($self->bin, "--git-dir=$project");
}
sub file_type {
my ($self, $mode) = @_;
# File type
if ($mode !~ m/^[0-7]+$/) { return $mode }
else { $mode = oct $mode }
if ($self->_s_isgitlink($mode)) { return 'submodule' }
elsif (S_ISDIR($mode & S_IFMT)) { return 'directory' }
elsif (S_ISLNK($mode)) { return 'symlink' }
elsif (S_ISREG($mode)) { return 'file' }
else { return 'unknown' }
return
}
sub file_type_long {
my ($self, $mode) = @_;
# File type
if ($mode !~ m/^[0-7]+$/) { return $mode }
else { $mode = oct $mode }
if (S_ISGITLINK($mode)) { return 'submodule' }
elsif (S_ISDIR($mode & S_IFMT)) { return 'directory' }
elsif (S_ISLNK($mode)) { return 'symlink' }
elsif (S_ISREG($mode)) {
if ($mode & S_IXUSR) { return 'executable' }
else { return 'file' }
}
else { return 'unknown' }
return;
}
sub fill_from_file_info {
my ($self, $project, $diff, $parents) = @_;
# Fill file info
$diff->{from_file} = [];
$diff->{from_file}[$diff->{nparents} - 1] = undef;
for (my $i = 0; $i < $diff->{nparents}; $i++) {
if ($diff->{status}[$i] eq 'R' || $diff->{status}[$i] eq 'C') {
$diff->{from_file}[$i] =
$self->path_by_id($project, $parents->[$i], $diff->{from_id}[$i]);
}
}
return $diff;
}
sub difftree {
my ($self, $project, $cid, $parent, $parents) = @_;
# Root
$parent = '--root' unless defined $parent;
# Command "git diff-tree"
my @cmd = ($self->cmd($project), "diff-tree", '-r', '--no-commit-id',
'-M', (@$parents <= 1 ? $parent : '-c'), $cid, '--');
open my $fh, "-|", @cmd
or croak 500, "Open git-diff-tree failed";
my @difftree = map { chomp; $self->dec($_) } <$fh>;
close $fh or croak 'Reading git-diff-tree failed';
# Parse "git diff-tree" output
my $diffs = [];
my @parents = @$parents;
for my $line (@difftree) {
my $diff = $self->parsed_difftree_line($line);
# Parent are more than one
if (exists $diff->{nparents}) {
$self->fill_from_file_info($project, $diff, $parents)
unless exists $diff->{from_file};
$diff->{is_deleted} = 1 if $self->is_deleted($diff);
push @$diffs, $diff;
}
# Parent is single
else {
my ($to_mode_oct, $to_mode_str, $to_file_type);
my ($from_mode_oct, $from_mode_str, $from_file_type);
if ($diff->{to_mode} ne ('0' x 6)) {
$to_mode_oct = oct $diff->{to_mode};
if (S_ISREG($to_mode_oct)) { # only for regular file
$to_mode_str = sprintf('%04o', $to_mode_oct & 0777); # permission bits
}
$to_file_type = $self->file_type($diff->{to_mode});
}
if ($diff->{from_mode} ne ('0' x 6)) {
$from_mode_oct = oct $diff->{from_mode};
if (S_ISREG($from_mode_oct)) { # only for regular file
$from_mode_str = sprintf('%04o', $from_mode_oct & 0777); # permission bits
}
$from_file_type = $self->file_type($diff->{from_mode});
}
$diff->{to_mode_str} = $to_mode_str;
$diff->{to_mode_oct} = $to_mode_oct;
$diff->{to_file_type} = $to_file_type;
$diff->{from_mode_str} = $from_mode_str;
$diff->{from_mode_oct} = $from_mode_oct;
$diff->{from_file_type} = $from_file_type;
push @$diffs, $diff;
}
}
return $diffs;
}
sub head_id {
my ($self, $project) = (shift, shift);
# HEAD id
return $self->id($project, 'HEAD', @_);
};
sub heads {
my ($self, $project, $limit, @classes) = @_;
# Command "git for-each-ref" (get heads)
@classes = ('heads') unless @classes;
my @patterns = map { "refs/$_" } @classes;
my @cmd = ($self->cmd($project), 'for-each-ref',
($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
'--format=%(objectname) %(refname) %(subject)%00%(committer)',
@patterns);
open my $fh, '-|', @cmd or return;
# Create head info
my @heads;
while (my $line = $self->dec(scalar <$fh>)) {
my %ref_item;
chomp $line;
my ($refinfo, $committerinfo) = split(/\0/, $line);
my ($cid, $name, $title) = split(' ', $refinfo, 3);
my ($committer, $epoch, $tz) =
($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
$ref_item{fullname} = $name;
$name =~ s!^refs/(?:head|remote)s/!!;
$ref_item{name} = $name;
$ref_item{id} = $cid;
$ref_item{title} = $title || '(no commit message)';
$ref_item{epoch} = $epoch;
if ($epoch) {
$ref_item{age} = $self->_age_string(time - $ref_item{epoch});
} else { $ref_item{age} = 'unknown' }
push @heads, \%ref_item;
}
close $fh;
return \@heads;
}
sub id {
my ($self, $project, $ref, @options) = @_;
# Command "git rev-parse" (get commit id)
my $id;
my @cmd = ($self->cmd($project), 'rev-parse',
'--verify', '-q', @options, $ref);
if (open my $fh, '-|', @cmd) {
$id = $self->dec(scalar <$fh>);
chomp $id if defined $id;
close $fh;
}
return $id;
}
sub id_by_path {
my ($self, $project, $commit_id, $path, $type) = @_;
# Get blob id or tree id (command "git ls-tree")
$path =~ s#/+$##;
my @cmd = ($self->cmd($project), 'ls-tree', $commit_id, '--', $path);
open my $fh, '-|', @cmd
or croak 'Open git-ls-tree failed';
my $line = $self->dec(scalar <$fh>);
close $fh or return;
my ($t, $id) = ($line || '') =~ m/^[0-9]+ (.+) ([0-9a-fA-F]{40})\t/;
return if defined $type && $type ne $t;
return $id;
}
sub path_by_id {
my $self = shift;
my $project = shift;
my $base = shift || return;
my $hash = shift || return;
# Command "git ls-tree"
my @cmd = ($self->cmd($project), 'ls-tree', '-r', '-t', '-z', $base);
open my $fh, '-|' or return;
# Get path
local $/ = "\0";
while (my $line = <$fh>) {
$line = d$line;
chomp $line;
if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
close $fh;
return $1;
}
}
close $fh;
return;
}
sub project_description {
my ($self, $project) = @_;
# Description
my $file = "$project/description";
my $description = $self->_slurp($file) || '';
return $description;
}
sub repository_description {
my ($self, $rep) = @_;
# Description
my $file = "$rep/description";
my $description = $self->_slurp($file) || '';
return $description;
}
sub last_activity {
my ($self, $project) = @_;
# Command "git for-each-ref"
my @cmd = ($self->cmd($project), 'for-each-ref',
'--format=%(committer)', '--sort=-committerdate',
'--count=1', 'refs/heads');
open my $fh, '-|', @cmd or return;
my $most_recent = $self->dec(scalar <$fh>);
close $fh or return;
# Parse most recent
if (defined $most_recent &&
$most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
my $timestamp = $1;
my $age = time - $timestamp;
return ($age, $self->_age_string($age));
}
return;
}
sub object_type {
my ($self, $project, $cid) = @_;
# Get object type (command "git cat-file")
my @cmd = ($self->cmd($project), 'cat-file', '-t', $cid);
open my $fh, '-|', @cmd or return;
my $type = $self->dec(scalar <$fh>);
close $fh or return;
chomp $type;
return $type;
}
sub project_owner {
my ($self, $project) = @_;
# Project owner
my $user_id = (stat $project)[4];
my $user = getpwuid $user_id;
return $user;
}
sub project_urls {
my ($self, $project) = @_;
# Project URLs
open my $fh, '<', "$project/cloneurl"
or return;
my @urls = map { chomp; $self->dec($_) } <$fh>;
close $fh;
return \@urls;
}
sub references {
my ($self, $project, $type) = @_;
$type ||= '';
# Command "git show-ref" (get references)
my @cmd = ($self->cmd($project), 'show-ref', '--dereference',
($type ? ('--', "refs/$type") : ()));
open my $fh, '-|', @cmd or return;
# Parse references
my %refs;
while (my $line = $self->dec(scalar <$fh>)) {
chomp $line;
if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
if (defined $refs{$1}) { push @{$refs{$1}}, $2 }
else { $refs{$1} = [$2] }
}
}
close $fh or return;
return \%refs;
}
sub fill_repositories {
my ($self, $home, $ps) = @_;
# Fill rep info
my @resp;
for my $rep (@$ps) {
my (@activity) = $self->last_activity("$home/$rep->{path}");
next unless @activity;
($rep->{age}, $rep->{age_string}) = @activity;
if (!defined $rep->{descr}) {
my $descr = $self->repository_description("$home/$rep->{path}") || '';
$rep->{descr_long} = $descr;
$rep->{descr} = $self->_chop_str($descr, 25, 5);
}
push @resp, $rep;
}
return \@resp;
}
sub repositories {
my ($self, $dir, %opt) = @_;
my $filter = $opt{filter};
# Repositories
opendir my $dh, $self->enc($dir)
or croak qq/Can't open directory $dir: $!/;
my @reps;
while (my $rep = readdir $dh) {
next unless $rep =~ /\.git$/;
next unless $self->check_head_link("$dir/$rep");
next if defined $filter && $rep !~ /\Q$filter\E/;
my $rep_name = $rep;
$rep_name =~ s/\.git$//;
push @reps, { name => $rep_name, path => $rep };
}
# Fill repositroies information
for my $rep (@reps) {
my (@activity) = $self->last_activity("$dir/$rep->{path}");
next unless @activity;
($rep->{age}, $rep->{age_string}) = @activity;
if (!defined $rep->{descr}) {
my $descr = $self->repository_description("$dir/$rep->{path}") || '';
$rep->{descr_long} = $descr;
$rep->{descr} = $self->_chop_str($descr, 25, 5);
}
}
return \@reps;
}
sub short_id {
my ($self, $project) = (shift, shift);
# Short id
return $self->id($project, @_, '--short=7');
}
sub tag {
my ($self, $project, $name) = @_;
# Tag
my $tags = $self->tags($project);
for my $tag (@$tags) {
return $tag if $tag->{name} eq $name;
}
return;
}
sub tags {
my ($self, $project, $limit) = @_;
# Get tags (command "git for-each-ref")
my @cmd = ($self->cmd($project), 'for-each-ref',
($limit ? '--count='.($limit+1) : ()), '--sort=-creatordate',
'--format=%(objectname) %(objecttype) %(refname) '.
'%(*objectname) %(*objecttype) %(subject)%00%(creator)',
'refs/tags');
open my $fh, '-|', @cmd or return;
# Parse Tags
my @tags;
while (my $line = $self->dec(scalar <$fh>)) {
my %tag;
chomp $line;
my ($refinfo, $creatorinfo) = split(/\0/, $line);
my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
my ($creator, $epoch, $tz) =
($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
$tag{fullname} = $name;
$name =~ s!^refs/tags/!!;
$tag{type} = $type;
$tag{id} = $id;
$tag{name} = $name;
if ($type eq 'tag') {
$tag{subject} = $title;
$tag{reftype} = $reftype;
$tag{refid} = $refid;
} else {
$tag{reftype} = $type;
$tag{refid} = $id;
}
if ($type eq 'tag' || $type eq 'commit') {
$tag{epoch} = $epoch;
if ($epoch) {
$tag{age} = $self->_age_string(time - $tag{epoch});
} else {
$tag{age} = 'unknown';
}
}
$tag{comment_short} = $self->_chop_str($tag{subject}, 30, 5)
if $tag{subject};
push @tags, \%tag;
}
close $fh;
return \@tags;
}
sub is_deleted {
my ($self, $diffinfo) = @_;
# Check if deleted
return $diffinfo->{to_id} eq ('0' x 40);
}
sub id_set_multi {
my ($self, $cid, $key, $value) = @_;
if (!exists $cid->{$key}) { $cid->{$key} = $value }
elsif (!ref $cid->{$key}) { $cid->{$key} = [ $cid->{$key}, $value ] }
else { push @{$cid->{$key}}, $value }
}
sub parse_commit {
my ($self, $project, $id) = @_;
# Git rev-list
my @cmd = ($self->cmd($project), 'rev-list', '--parents',
'--header', '--max-count=1', $id, '--');
open my $fh, '-|', @cmd
or croak 'Open git-rev-list failed';
# Parse commit
local $/ = "\0";
my $content = $self->dec(scalar <$fh>);
my $commit = $self->parse_commit_text($content, 1);
close $fh;
return $commit;
}
sub parse_commit_text {
my ($self, $commit_text, $withparents) = @_;
my @commit_lines = split '\n', $commit_text;
my %commit;
pop @commit_lines; # Remove '\0'
return unless @commit_lines;
my $header = shift @commit_lines;
return if $header !~ m/^[0-9a-fA-F]{40}/;
($commit{id}, my @parents) = split ' ', $header;
while (my $line = shift @commit_lines) {
last if $line eq "\n";
if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
$commit{tree} = $1;
} elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
push @parents, $1;
} elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
$commit{author} = $1;
$commit{author_epoch} = $2;
$commit{author_tz} = $3;
if ($commit{author} =~ m/^([^<]+) <([^>]*)>/) {
$commit{author_name} = $1;
$commit{author_email} = $2;
} else {
$commit{author_name} = $commit{author};
}
} elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
$commit{committer} = $1;
$commit{committer_epoch} = $2;
$commit{committer_tz} = $3;
if ($commit{committer} =~ m/^([^<]+) <([^>]*)>/) {
$commit{committer_name} = $1;
$commit{committer_email} = $2;
} else {
$commit{committer_name} = $commit{committer};
}
}
}
return unless defined $commit{tree};
$commit{parents} = \@parents;
$commit{parent} = $parents[0];
for my $title (@commit_lines) {
$title =~ s/^ //;
if ($title ne '') {
$commit{title} = $self->_chop_str($title, 80, 5);
# remove leading stuff of merges to make the interesting part visible
if (length($title) > 50) {
$title =~ s/^Automatic //;
$title =~ s/^merge (of|with) /Merge ... /i;
if (length($title) > 50) {
$title =~ s/(http|rsync):\/\///;
}
if (length($title) > 50) {
$title =~ s/(master|www|rsync)\.//;
}
if (length($title) > 50) {
$title =~ s/kernel.org:?//;
}
if (length($title) > 50) {
$title =~ s/\/pub\/scm//;
}
}
$commit{title_short} = $self->_chop_str($title, 50, 5);
last;
}
}
if (! defined $commit{title} || $commit{title} eq '') {
$commit{title} = $commit{title_short} = '(no commit message)';
}
# remove added spaces
for my $line (@commit_lines) {
$line =~ s/^ //;
}
$commit{comment} = \@commit_lines;
my $age = time - $commit{committer_epoch};
$commit{age} = $age;
$commit{age_string} = $self->_age_string($age);
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($commit{committer_epoch});
if ($age > 60*60*24*7*2) {
$commit{age_string_date} = sprintf '%4i-%02u-%02i', 1900 + $year, $mon+1, $mday;
$commit{age_string_age} = $commit{age_string};
} else {
$commit{age_string_date} = $commit{age_string};
$commit{age_string_age} = sprintf '%4i-%02u-%02i', 1900 + $year, $mon+1, $mday;
}
return \%commit;
}
sub parse_commits {
my ($self, $project, $cid, $maxcount, $skip, $file, @args) = @_;
# git rev-list
$maxcount ||= 1;
$skip ||= 0;
my @cmd = ($self->cmd($project), 'rev-list', '--header', @args,
('--max-count=' . $maxcount), ('--skip=' . $skip), $cid, '--',
($file ? ($file) : ()));
open my $fh, '-|', @cmd
or croak 'Open git-rev-list failed';
# Parse rev-list results
local $/ = "\0";
my @commits;
while (my $line = $self->dec(scalar <$fh>)) {
my $commit = $self->parse_commit_text($line);
push @commits, $commit;
}
close $fh;
return \@commits;
}
sub parse_date {
my $self = shift;
my $epoch = shift;
my $tz = shift || '-0000';
# Parse data
my %date;
my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
my @days = qw/Sun Mon Tue Wed Thu Fri Sat/;
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime $epoch;
$date{hour} = $hour;
$date{minute} = $min;
$date{mday} = $mday;
$date{day} = $days[$wday];
$date{month} = $months[$mon];
$date{rfc2822} = sprintf '%s, %d %s %4d %02d:%02d:%02d +0000',
$days[$wday], $mday, $months[$mon], 1900 + $year, $hour ,$min, $sec;
$date{'mday-time'} = sprintf '%d %s %02d:%02d',
$mday, $months[$mon], $hour ,$min;
$date{'iso-8601'} = sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
1900 + $year, 1+$mon, $mday, $hour ,$min, $sec;
my ($tz_sign, $tz_hour, $tz_min) = ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
$tz_sign = ($tz_sign eq '-' ? -1 : +1);
my $local = $epoch + $tz_sign * ((($tz_hour*60) + $tz_min) * 60);
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime $local;
$date{hour_local} = $hour;
$date{minute_local} = $min;
$date{tz_local} = $tz;
$date{'iso-tz'} = sprintf('%04d-%02d-%02d %02d:%02d:%02d %s',
1900 + $year, $mon+1, $mday, $hour, $min, $sec, $tz);
return \%date;
}
sub parsed_difftree_line {
my ($self, $line) = @_;
return $line if ref $line eq 'HASH';
return $self->parse_difftree_raw_line($line);
}
sub parse_difftree_raw_line {
my ($self, $line) = @_;
my %res;
if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
$res{from_mode} = $1;
$res{to_mode} = $2;
$res{from_id} = $3;
$res{to_id} = $4;
$res{status} = $5;
$res{similarity} = $6;
if ($res{status} eq 'R' || $res{status} eq 'C') {
($res{from_file}, $res{to_file}) = map { $self->_unquote($_) } split("\t", $7);
} else {
$res{from_file} = $res{to_file} = $res{file} = $self->_unquote($7);
}
}
elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
$res{nparents} = length($1);
$res{from_mode} = [ split(' ', $2) ];
$res{to_mode} = pop @{$res{from_mode}};
$res{from_id} = [ split(' ', $3) ];
$res{to_id} = pop @{$res{from_id}};
$res{status} = [ split('', $4) ];
$res{to_file} = $self->_unquote($5);
}
elsif ($line =~ m/^([0-9a-fA-F]{40})$/) { $res{commit} = $1 }
return \%res;
}
sub parse_ls_tree_line {
my ($self, $line) = @_;
my %opts = @_;
my %res;
if ($opts{'-l'}) {
$line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
$res{mode} = $1;
$res{type} = $2;
$res{hash} = $3;
$res{size} = $4;
if ($opts{'-z'}) { $res{name} = $5 }
else { $res{name} = $self->_unquote($5) }
}
else {
$line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
$res{mode} = $1;
$res{type} = $2;
$res{hash} = $3;
if ($opts{'-z'}) { $res{name} = $4 }
else { $res{name} = $self->_unquote($4) }
}
return \%res;
}
sub parse_tag {
my ($self, $project, $tag_id) = @_;
# Get tag (command "git cat-file")
my @cmd = ($self->cmd($project), 'cat-file', 'tag', $tag_id);
open my $fh, '-|', @cmd or return;
# Parse tag
my %tag;
my @comment;
$tag{id} = $tag_id;
while (my $line = $self->dec(scalar <$fh>)) {
chomp $line;
if ($line =~ m/^object ([0-9a-fA-F]{40})$/) { $tag{object} = $1 }
elsif ($line =~ m/^type (.+)$/) { $tag{type} = $1 }
elsif ($line =~ m/^tag (.+)$/) { $tag{name} = $1 }
elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
$tag{author} = $1;
$tag{author_epoch} = $2;
$tag{author_tz} = $3;
if ($tag{author} =~ m/^([^<]+) <([^>]*)>/) {
$tag{author_name} = $1;
$tag{author_email} = $2;
} else { $tag{author_name} = $tag{author} }
} elsif ($line =~ m/--BEGIN/) {
push @comment, $line;
last;
} elsif ($line eq '') { last }
}
my $comment = $self->dec(scalar <$fh>);
push @comment, $comment;
$tag{comment} = \@comment;
close $fh or return;
return unless defined $tag{name};
return \%tag;
}
sub search_bin {
my $self = shift;
# Search git bin
my $env_path = $ENV{PATH};
my @paths = split /:/, $env_path;
for my $path (@paths) {
$path =~ s#/$##;
my $bin = "$path/git";
if (-f $bin) {
return $bin;
last;
}
}
my $local_bin = '/usr/local/bin/git';
return $local_bin if -f $local_bin;
my $bin = '/usr/bin/git';
return $bin if -f $bin;
return;
}
sub search_projects {
my ($self, %opt) = @_;
my $dirs = $self->search_dirs;
my $max_depth = $self->search_max_depth;
# Search
my @projects;
for my $dir (@$dirs) {
next unless -d $dir;
$dir =~ s/\/$//;
my $prefix_length = length($dir);
my $prefix_depth = 0;
for my $c (split //, $dir) {
$prefix_depth++ if $c eq '/';
}
no warnings 'File::Find';
File::Find::find({
follow_fast => 1,
follow_skip => 2,
dangling_symlinks => 0,
wanted => sub {
my $path = $File::Find::name;
my $base_path = $_;
return if (m!^[/.]$!);
return unless -d $base_path;
if ($base_path eq '.git') {
$File::Find::prune = 1;
return;
};
my $depth = 0;
for my $c (split //, $dir) {
$depth++ if $c eq '/';
}
if ($depth - $prefix_depth > $max_depth) {
$File::Find::prune = 1;
return;
}
if (-d $path) {
if ($self->check_head_link($path)) {
my $home = dirname $path;
my $name = basename $path;
push @projects, {home => $home, name => $name};
$File::Find::prune = 1;
}
}
},
}, $dir);
}
return \@projects;
}
sub snapshot_name {
my ($self, $project, $cid) = @_;
my $name = $project;
$name =~ s,([^/])/*\.git$,$1,;
$name = basename($name);
# sanitize name
$name =~ s/[[:cntrl:]]/?/g;
my $ver = $cid;
if ($cid =~ /^[0-9a-fA-F]+$/) {
my $full_hash = $self->id($project, $cid);
if ($full_hash =~ /^$cid/ && length($cid) > 7) {
$ver = $self->short_id($project, $cid);
}
} elsif ($cid =~ m!^refs/tags/(.*)$!) {
$ver = $1;
} else {
if ($cid =~ m!^refs/(?:heads|remotes)/(.*)$!) {
$ver = $1;
}
$ver .= '-' . $self->short_id($project, $cid);
}
$ver =~ s!/!.!g;
$name = "$name-$ver";
return wantarray ? ($name, $name) : $name;
}
sub _age_string {
my ($self, $age) = @_;
my $age_str;
if ($age > 60*60*24*365*2) {
$age_str = (int $age/60/60/24/365);
$age_str .= ' years ago';
} elsif ($age > 60*60*24*(365/12)*2) {
$age_str = int $age/60/60/24/(365/12);
$age_str .= ' months ago';
} elsif ($age > 60*60*24*7*2) {
$age_str = int $age/60/60/24/7;
$age_str .= ' weeks ago';
} elsif ($age > 60*60*24*2) {
$age_str = int $age/60/60/24;
$age_str .= ' days ago';
} elsif ($age > 60*60*2) {
$age_str = int $age/60/60;
$age_str .= ' hours ago';
} elsif ($age > 60*2) {
$age_str = int $age/60;
$age_str .= ' min ago';
} elsif ($age > 2) {
$age_str = int $age;
$age_str .= ' sec ago';
} else {
$age_str .= ' right now';
}
return $age_str;
}
sub _chop_str {
my $self = shift;
my $str = shift;
my $len = shift;
my $add_len = shift || 10;
my $where = shift || 'right';
if ($where eq 'center') {
# Filler is length 5
return $str if ($len + 5 >= length($str));
$len = int($len/2);
} else {
# Filler is length 4
return $str if ($len + 4 >= length($str));
}
# Regexps: ending and beginning with word part up to $add_len
my $endre = qr/.{$len}\w{0,$add_len}/;
my $begre = qr/\w{0,$add_len}.{$len}/;
if ($where eq 'left') {
$str =~ m/^(.*?)($begre)$/;
my ($lead, $body) = ($1, $2);
if (length($lead) > 4) {
$lead = ' ...';
}
return "$lead$body";
} elsif ($where eq 'center') {
$str =~ m/^($endre)(.*)$/;
my ($left, $str) = ($1, $2);
$str =~ m/^(.*?)($begre)$/;
my ($mid, $right) = ($1, $2);
if (length($mid) > 5) {
$mid = ' ... ';
}
return "$left$mid$right";
} else {
$str =~ m/^($endre)(.*)$/;
my $body = $1;
my $tail = $2;
if (length($tail) > 4) {
$tail = '... ';
}
return "$body$tail";
}
}
sub _mode_str {
my $self = shift;
my $mode = oct shift;
# Mode to string
if ($self->_s_isgitlink($mode)) { return 'm---------' }
elsif (S_ISDIR($mode & S_IFMT)) { return 'drwxr-xr-x' }
elsif (S_ISLNK($mode)) { return 'lrwxrwxrwx' }
elsif (S_ISREG($mode)) {
if ($mode & S_IXUSR) {
return '-rwxr-xr-x';
} else {
return '-rw-r--r--'
}
} else { return '----------' }
return;
}
sub _s_isgitlink {
my ($self, $mode) = @_;
# Check if git link
my $s_ifgitlink = 0160000;
return (($mode & S_IFMT) == $s_ifgitlink)
}
sub timestamp {
my ($self, $date) = @_;
# Time stamp
my $strtime = $date->{rfc2822};
my $localtime_format = '(%02d:%02d %s)';
if ($date->{hour_local} < 6) { $localtime_format = '(%02d:%02d %s)' }
$strtime .= ' ' . sprintf(
$localtime_format,
$date->{hour_local},
$date->{minute_local},
$date->{tz_local}
);
return $strtime;
}
sub _slurp {
my ($self, $file) = @_;
# Slurp
open my $fh, '<', $file
or croak qq/Can't open file "$file": $!/;
my $content = do { local $/; $self->dec(scalar <$fh>) };
close $fh;
return $content;
}
sub _unquote {
my ($self, $str) = @_;
# Unquote function
my $unq = sub {
my $seq = shift;
my %escapes = (
t => "\t",
n => "\n",
r => "\r",
f => "\f",
b => "\b",
a => "\a",
e => "\e",
v => "\013",
);
if ($seq =~ m/^[0-7]{1,3}$/) { return chr oct $seq }
elsif (exists $escapes{$seq}) { return $escapes{$seq} }
return $seq;
};
# Unquote
if ($str =~ m/^"(.*)"$/) {
$str = $1;
$str =~ s/\\([^0-7]|[0-7]{1,3})/$unq->($1)/eg;
}
return $str;
}
sub _tab_to_space {
my ($self, $line) = @_;
# Tab to space
while ((my $pos = index($line, "\t")) != -1) {
if (my $count = (2 - ($pos % 2))) {
my $spaces = ' ' x $count;
$line =~ s/\t/$spaces/;
}
}
return $line;
}
1;