binmode
STDOUT,
':utf8'
;
has
'git_dir'
=> (
is
=>
'ro'
,
isa
=>
'Str'
,
default
=>
""
);
has
'gitcmd'
=> (
is
=>
'rw'
,
isa
=>
'Str'
,
default
=>
'git'
);
has
'bare'
=> (
is
=>
'rw'
,
default
=>0);
has
'name'
=> (
is
=>
'rw'
,
isa
=>
'Str'
);
has
'branches'
=> (
is
=>
'rw'
,
default
=>
sub
{
return
[];});
has
'languages'
=> (
is
=>
'rw'
,
default
=>
sub
{
return
[];});
sub
isGit
{
my
$self
=
shift
;
return
0
unless
-d
$self
->git_dir();
if
(-d
$self
->git_dir .
"/.git"
)
{
$self
->bare(0);
return
1;
}
my
$help
=
readpipe
(
$self
->gitcmd() .
' rev-parse --git-dir 1>/dev/null 2> /dev/null;echo $?'
);
chomp
(
$help
);
if
(
$help
== 0)
{
$self
->bare(1);
return
1;
}
return
0;
}
sub
parse_branches
{
my
$self
=
shift
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" show-ref --dereference"
);
my
@lines
=
split
/\n/,
$help
;
$self
->branches([]);
for
my
$line
(
@lines
)
{
if
(
$line
=~ m!^([0-9a-fA-F]{40})\srefs/(.*)$!) {
my
$branch
= {
name
=> $2,
ref
=> $1
};
if
(
$branch
->{name} !~ /^tags/ &&
$branch
->{name} !~ /^remote/)
{
push
(@{
$self
->branches},
$branch
);
}
}
}
}
sub
hasBranch
{
my
$self
=
shift
;
my
$branch
=
shift
;
for
my
$b
(@{
$self
->branches})
{
if
(
$b
->{name} eq
$branch
)
{
return
1;
}
}
return
0;
}
sub
getBranchRef
{
my
$self
=
shift
;
my
$branch
=
shift
;
for
my
$b
(@{
$self
->branches})
{
if
(
$b
->{name} eq
$branch
)
{
return
$b
->{
ref
};
}
}
return
;
}
sub
getFileRef
{
my
$self
=
shift
;
my
$branch
=
shift
;
my
$file
=
shift
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" ls-tree "
.
$branch
.
" "
.
$file
);
chomp
(
$help
);
if
(
$help
=~ /^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/)
{
return
$3;
}
return
;
}
sub
hasMetaData
{
my
$self
=
shift
;
return
0
unless
$self
->hasBranch(
"heads/metadata"
);
}
sub
tags {
my
$self
=
shift
;
my
@tags
;
return
[]
unless
$self
->hasMetaData;
my
$ref
=
$self
->getFileRef(
"metadata"
,
"tags"
);
warn
(
"No tags file found in metadata branch ("
.
$self
->git_dir .
")"
)
unless
$ref
;
return
unless
$ref
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" cat-file blob "
.
$ref
);
my
@lines
=
split
/\n/,
$help
;
for
my
$line
(
@lines
)
{
push
(
@tags
,
$line
);
}
return
@tags
;
}
sub
description {
my
$self
=
shift
;
my
@tags
;
return
[]
unless
$self
->hasMetaData;
my
$ref
=
$self
->getFileRef(
"metadata"
,
"description"
);
warn
(
"No description file found in metadata branch ("
.
$self
->git_dir .
")"
)
unless
$ref
;
return
unless
$ref
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" cat-file blob "
.
$ref
);
chomp
(
$help
);
return
$help
;
}
sub
hasLanguage
{
my
$self
=
shift
;
my
$lang
=
shift
;
for
my
$l
(@{
$self
->languages})
{
if
(
$l
eq
$lang
)
{
return
1;
}
}
return
0;
}
sub
parse_languages
{
my
$self
=
shift
;
my
$shared
= dist_dir(
'HiD-Generator-GitRepositories'
);
$self
->languages([]);
return
unless
$self
->hasMetaData();
my
$json_text
=
do
{
open
(
my
$json_fh
,
"<:encoding(UTF-8)"
,
$shared
.
"/extensions.json"
)
or
die
(
"Can't open \$filename\": $!\n"
);
local
$/;
<
$json_fh
>
};
my
$extensions
=from_json(
$json_text
);
for
my
$b
(@{
$self
->branches})
{
my
$help
=
readpipe
(
$self
->gitcmd() .
" ls-tree "
.
$b
->{name} .
" -r"
);
my
@lines
=
split
/\n/,
$help
;
for
my
$l
(
@lines
)
{
if
(
$l
=~ /^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/)
{
my
$filename
= fileparse($4);
$filename
=~/^.*(\..+)$/;
my
$extension
=$1;
if
(
$extension
=~/\S+/) {
for
my
$ee
(@{
$extensions
})
{
if
(
$ee
->{type} eq
"programming"
) {
for
my
$e
(@{
$ee
->{extensions}})
{
if
(
$e
eq
$extension
)
{
push
(@{
$self
->languages},
$ee
->{name})
unless
$self
->hasLanguage(
$ee
->{name});
}
}
}
}
}
}
}
}
}
sub
lastActivity
{
my
$self
=
shift
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" for-each-ref --format=\'%(committer)\' --sort=-committerdate --count=1"
);
chomp
(
$help
);
if
(
$help
=~ / (\d+) [-+][01]\d\d\d$/)
{
my
$dt
= DateTime->from_epoch(
epoch
=> $1 );
return
$dt
->month_name .
" "
.
$dt
->day .
" "
.
$dt
->year;
}
return
;
}
sub
lastChange
{
my
$self
=
shift
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" for-each-ref --format=\'%(committer)\' --sort=-committerdate --count=1"
);
chomp
(
$help
);
if
(
$help
=~ / (\d+) ([-+][01]\d\d\d)$/)
{
my
$tz
=DateTime::TimeZone->new(
name
=>
'local'
);
my
$dt
= DateTime->from_epoch(
epoch
=> $1 ,
time_zone
=>
$tz
);
return
$dt
;
}
return
;
}
sub
lastChangeBranch
{
my
$self
=
shift
;
my
$branch
=
shift
||
"heads/master"
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" for-each-ref --format=\'%(refname) %(committer)\' --sort=-committerdate | grep \""
.
$branch
.
"\""
);
chomp
(
$help
);
if
(
$help
=~ / (\d+) [-+][01]\d\d\d$/)
{
my
$dt
= DateTime->from_epoch(
epoch
=> $1 );
return
$dt
;
}
return
;
}
sub
getFileLog
{
my
$self
=
shift
;
my
$branch
=
shift
||
"master"
;
my
$file
=
shift
||
"."
;
my
$nr
=
shift
|| 20;
my
$skip
=
shift
|| 0;
my
@log
;
my
$help
=
readpipe
(
" LC_ALL=C "
.
$self
->gitcmd() .
" log --follow --date=raw --max-count="
.
$nr
.
" --skip="
.
$skip
.
" "
.
$branch
.
" -- "
.
$file
);
my
@lines
=
split
/\n/,
$help
;
my
%entry
;
my
$start_comment
=0;
for
my
$line
(
@lines
)
{
if
(
$line
=~ /^commit\s([a-fA-F0-9]+)/)
{
my
$commit
= $1;
if
(
defined
(
$entry
{commit}))
{
push
(
@log
, \
%entry
);
}
%entry
=();
$entry
{commit}=
$commit
;
}
if
(
$line
=~ /^Author:\s(.*)\s<(.*)>$/)
{
$entry
{author}->{name}=$1;
$entry
{author}->{email}=$2;
}
if
(
$line
=~/^Date:\s+(\d+)/)
{
$entry
{date}=$1;
}
if
(
$line
=~/^\s*$/ &&
$start_comment
==0)
{
$start_comment
=1;
}
elsif
(
$line
=~/^\s*$/ &&
$start_comment
==1)
{
$start_comment
=0;
}
elsif
(
$start_comment
== 1)
{
$entry
{comment} .=
$line
;
}
}
push
(
@log
,\
%entry
);
return
@log
;
}
sub
getTree
{
my
$self
=
shift
;
my
$branch
=
shift
||
"master"
;
my
$root
=
shift
;
my
@tree
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" ls-tree "
.
$branch
.
" "
.
$root
);
my
@lines
=
split
/\n/,
$help
;
for
my
$l
(
@lines
)
{
$l
=~ /^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/;
my
$path
= $4;
my
$type
= $2;
my
$name
= fileparse(
$path
);
my
@log
=
$self
->getFileLog(
$branch
,
$path
, 1, 0);
my
$entry
={
type
=>
$type
,
ref
=> $3,
path
=>
$path
,
name
=>
$name
,
mode
=> $1,
commit
=>
$log
[0]
};
push
(
@tree
,
$entry
);
}
return
@tree
;
}
sub
getBlob
{
my
$self
=
shift
;
my
$ref
=
shift
;
my
$help
=
readpipe
(
$self
->gitcmd() .
" cat-file blob "
.
$ref
);
return
$help
;
}
sub
BUILD {
my
$self
=
shift
;
die
(
"directory parameter missing ("
.
$self
->git_dir .
" )"
)
unless
length
(
$self
->git_dir())>0;
die
(
"directory does not exist ("
.
$self
->git_dir .
" )"
)
unless
-d
$self
->git_dir();
die
(
"directory is not a git repository ("
.
$self
->git_dir .
" )"
)
unless
$self
->isGit();
$self
->gitcmd(
$self
->gitcmd .
' --git-dir='
.
$self
->git_dir());
if
(
$self
->bare()==0)
{
$self
->gitcmd(
$self
->gitcmd .
"/.git"
);
}
$self
->name(fileparse(
$self
->git_dir));
$self
->parse_branches();
};
sub
generate {
my
(
$self
,
$site
) =
@_
;
}
1;