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;