Newer Older
1797 lines | 42.33kb
renamed gitpub to gitprep
Yuki Kimoto authored on 2012-11-26
1
package Gitprep::Git;
copy gitweblite soruce code
root authored on 2012-11-23
2
use Mojo::Base -base;
3

            
4
use Carp 'croak';
cleanup
Yuki Kimoto authored on 2013-05-14
5
use Encode qw/encode decode/;
Supported specific character...
Tetsuya Hayashi authored on 2014-03-15
6
use Encode::Guess;
copy gitweblite soruce code
root authored on 2012-11-23
7
use Fcntl ':mode';
cleanup
Yuki Kimoto authored on 2013-05-14
8
use File::Basename qw/basename dirname/;
improved create repository f...
Yuki Kimoto authored on 2013-03-20
9
use File::Copy 'move';
cleanup
Yuki Kimoto authored on 2013-05-14
10
use File::Find 'find';
11
use File::Path qw/mkpath rmtree/;
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
12
use POSIX 'floor';
fix bug that in CGI reposito...
Yuki Kimoto authored on 2015-11-05
13
use Gitprep::Util;
added create repository feat...
Yuki Kimoto authored on 2013-03-18
14

            
15
# Attributes
16
has 'bin';
Renamed encoding to default_...
Tetsuya Hayashi authored on 2014-03-15
17
has default_encoding => 'UTF-8';
cleanup blob page
Yuki Kimoto authored on 2013-03-19
18
has text_exts => sub { ['txt'] };
add time zone system
Yuki Kimoto authored on 2014-03-08
19
has 'time_zone_second';
cleanup encoding
Yuki Kimoto authored on 2016-04-05
20
has 'app';
copy gitweblite soruce code
root authored on 2012-11-23
21

            
fix pull_request table bug
Yuki Kimoto authored on 2016-04-27
22
sub ref_to_object_id {
23
  my ($self, $rep_info, $ref) = @_;
24
  
25
  my @cmd = $self->cmd($rep_info, 'show-ref', $ref);
26
  open my $fh, '-|', @cmd
27
    or croak "Can't execute git show-ref: @cmd";
28
  my $result = <$fh>;
29
  
30
  return unless defined $result;
31
  
32
  my ($object_id) = split /\s+/, $result;
33
  
34
  return $object_id;
35
}
36

            
cleanup compare logic
Yuki Kimoto authored on 2016-04-18
37
sub current_branch {
38
  my ($self, $rep_info) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
39
  
cleanup compare logic
Yuki Kimoto authored on 2016-04-18
40
  my @cmd = $self->cmd($rep_info, 'rev-parse',  '--abbrev-ref', 'HEAD');
cleanup branch_status
Yuki Kimoto authored on 2016-04-16
41
  
42
  open my $fh, '-|', @cmd
43
    or croak "Can't get current branch: @cmd";
44
  my $current_branch = <$fh>;
45
  chomp $current_branch;
46
  
47
  return $current_branch;
cleanup
Yuki Kimoto authored on 2013-05-14
48
}
49

            
cleanup compare logic
Yuki Kimoto authored on 2016-04-18
50
sub branch_names {
51
  my ($self, $rep_info) = @_;
52
  
53
  # Branch names
54
  my @cmd = $self->cmd($rep_info, 'branch');
55
  open my $fh, '-|', @cmd or return;
56
  
57
  my @lines = <$fh>;
58
  my @branch_names;
59
  for my $branch_name (@lines) {
60
    chomp $branch_name;
61
    $branch_name =~ s/^\*//;
62
    $branch_name =~ s/^\s*//;
63
    $branch_name =~ s/\s*$//;
64
    
65
    push @branch_names, $branch_name;
66
  }
67
  
68
  return \@branch_names;
69
}
70

            
cleanup branch_status
Yuki Kimoto authored on 2016-04-16
71
sub branch {
cleanup
Yuki Kimoto authored on 2016-04-16
72
  my ($self, $rep_info, $branch_name) = @_;
cleanup branch
Yuki Kimoto authored on 2016-04-16
73
  
74
  # Branch
75
  $branch_name =~ s/^\*//;
76
  $branch_name =~ s/^\s*//;
77
  $branch_name =~ s/\s*$//;
78
  my $branch = {};
79
  $branch->{name} = $branch_name;
cleanup methods
Yuki Kimoto authored on 2016-04-16
80
  my $commit = $self->get_commit($rep_info, $branch_name);
cleanup branch
Yuki Kimoto authored on 2016-04-16
81
  $branch->{commit} = $commit;
82

            
83
  return $branch;
84
}
85

            
cleanup
Yuki Kimoto authored on 2013-05-14
86
sub branch_status {
cleanup
Yuki Kimoto authored on 2016-04-16
87
  my ($self, $rep_info, $branch1, $branch2) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
88
  
89
  # Branch status
90
  my $status = {ahead => 0, behind => 0};
cleanup cmd
Yuki Kimoto authored on 2016-04-16
91
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
92
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
93
    'rev-list',
94
    '--left-right',
95
    "$branch1...$branch2"
cleanup
Yuki Kimoto authored on 2013-05-14
96
  );
97
  open my $fh, '-|', @cmd
98
    or croak "Can't get branch status: @cmd";
99
  while (my $line = <$fh>) {
100
    if ($line =~ /^</) { $status->{behind}++ }
101
    elsif ($line =~ /^>/) { $status->{ahead}++ }
102
  }
103
  
104
  return $status;
105
}
106

            
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
107
sub no_merged_branch_h {
cleanup
Yuki Kimoto authored on 2016-04-16
108
  my ($self, $rep_info) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
109
  
110
  # No merged branches
111
  my $no_merged_branches_h = {};
112
  {
cleanup
Yuki Kimoto authored on 2016-04-16
113
    my @cmd = $self->cmd($rep_info, 'branch', '--no-merged');
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
114
    open my $fh, '-|', @cmd or return;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
115
    my @lines = <$fh>;
116
    for my $branch_name (@lines) {
117
      $branch_name = $self->_dec($branch_name);
cleanup
Yuki Kimoto authored on 2013-05-14
118
      $branch_name =~ s/^\*//;
119
      $branch_name =~ s/^\s*//;
120
      $branch_name =~ s/\s*$//;
121
      $no_merged_branches_h->{$branch_name} = 1;
122
    }
123
  }
124
  
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
125
  return $no_merged_branches_h;
126
}
127

            
128
sub branches {
cleanup
Yuki Kimoto authored on 2016-04-16
129
  my ($self, $rep_info) = @_;
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
130
  
cleanup
Yuki Kimoto authored on 2013-05-14
131
  # Branches
cleanup
Yuki Kimoto authored on 2016-04-16
132
  my @cmd = $self->cmd($rep_info, 'branch');
cleanup
Yuki Kimoto authored on 2013-05-14
133
  open my $fh, '-|', @cmd or return;
134
  my $branches = [];
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
135
  my $start;
136
  my $no_merged_branches_h;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
137
  my @lines = <$fh>;
138
  for my $branch_name (@lines) {
139
    $branch_name = $self->_dec($branch_name);
fix no merged branch not sho...
Yuki Kimoto authored on 2013-05-27
140
    $branch_name =~ s/^\*//;
141
    $branch_name =~ s/^\s*//;
142
    $branch_name =~ s/\s*$//;
cleanup
Yuki Kimoto authored on 2013-05-14
143
    
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
144
    # No merged branch
cleanup
Yuki Kimoto authored on 2016-04-16
145
    $no_merged_branches_h = $self->no_merged_branch_h($rep_info)
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
146
      unless $start++;
147
    
cleanup
Yuki Kimoto authored on 2013-05-14
148
    # Branch
cleanup
Yuki Kimoto authored on 2016-04-16
149
    my $branch = $self->branch($rep_info, $branch_name);
cleanup
Yuki Kimoto authored on 2013-05-14
150
    $branch->{no_merged} = 1 if $no_merged_branches_h->{$branch_name};
151
    push @$branches, $branch;
152
  }
153
  @$branches = sort { $a->{commit}{age} <=> $b->{commit}{age} } @$branches;
154
  
155
  return $branches;
156
}
157

            
158
sub branches_count {
cleanup
Yuki Kimoto authored on 2016-04-16
159
  my ($self, $rep_info) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
160
  
161
  # Branches count
cleanup
Yuki Kimoto authored on 2016-04-16
162
  my @cmd = $self->cmd($rep_info, 'branch');
cleanup
Yuki Kimoto authored on 2013-05-14
163
  open my $fh, '-|', @cmd or return;
164
  my @branches = <$fh>;
165
  my $branches_count = @branches;
166
  
167
  return $branches_count;
168
}
169

            
cleanup cmd
Yuki Kimoto authored on 2016-04-16
170
sub cmd {
cleanup
Yuki Kimoto authored on 2016-04-16
171
  my ($self, $rep_info, @command) = @_;
cleanup cmd
Yuki Kimoto authored on 2016-04-16
172
  
cleanup merge and push logic
Yuki Kimoto authored on 2016-04-27
173
  $rep_info //= {};
174
  
cleanup
Yuki Kimoto authored on 2016-04-16
175
  my $git_dir = $rep_info->{git_dir};
176
  my $work_tree = $rep_info->{work_tree};
cleanup cmd
Yuki Kimoto authored on 2016-04-16
177
  
178
  my @command_all = ($self->bin);
179
  if (defined $git_dir) {
180
    push @command_all, "--git-dir=$git_dir";
181
  }
182
  if (defined $work_tree) {
183
    push @command_all, "--work-tree=$work_tree";
184
  }
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
185
  push @command_all, @command;
cleanup cmd
Yuki Kimoto authored on 2016-04-16
186
  
187
  return @command_all;
188
}
189

            
added contributer count
Yuki Kimoto authored on 2013-01-28
190
sub authors {
cleanup
Yuki Kimoto authored on 2016-04-16
191
  my ($self, $rep_info, $rev, $file) = @_;
added contributer count
Yuki Kimoto authored on 2013-01-28
192
  
cleanup
Yuki Kimoto authored on 2013-05-14
193
  # Authors
cleanup authors
Yuki Kimoto authored on 2016-04-16
194
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
195
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
196
    'log',
197
    '--format=%an',
198
    $rev,
199
    '--',
200
    $file
cleanup blob page
Yuki Kimoto authored on 2013-03-19
201
  );
added contributer count
Yuki Kimoto authored on 2013-01-28
202
  open my $fh, "-|", @cmd
203
    or croak 500, "Open git-cat-file failed";
204
  my $authors = {};
cleanup encoding
Yuki Kimoto authored on 2016-04-05
205
  my @lines = <$fh>;
206
  for my $line (@lines) {
207
    $line = $self->_dec($line);
added contributer count
Yuki Kimoto authored on 2013-01-28
208
    $line =~ s/[\r\n]//g;
209
    $authors->{$line} = 1;
210
  }
211
  
212
  return [sort keys %$authors];
213
}
214

            
add blame method
Yuki Kimoto authored on 2013-08-10
215
sub blame {
cleanup
Yuki Kimoto authored on 2016-04-16
216
  my ($self, $rep_info, $rev, $file) = @_;
add blame method
Yuki Kimoto authored on 2013-08-10
217
  
218
  # Git blame
cleanup blame
Yuki Kimoto authored on 2016-04-16
219
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
220
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
221
    'blame',
222
    '--line-porcelain',
223
    $rev,
224
    '--',
225
    $file
add blame method
Yuki Kimoto authored on 2013-08-10
226
  );
227
  open my $fh, '-|', @cmd
228
    or croak "Can't git blame --line-porcelain";
229
  
230
  # Format lines
231
  my $blame_lines = [];
232
  my $blame_line;
add hot color to blame page
Yuki Kimoto authored on 2013-08-10
233
  my $max_author_time;
234
  my $min_author_time;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
235
  my @lines = <$fh>;
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
236
  
cleanup methods
Yuki Kimoto authored on 2016-04-16
237
  my $enc = $self->decide_encoding($rep_info, \@lines);
cleanup encoding
Yuki Kimoto authored on 2016-04-05
238
  for my $line (@lines) {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
239
    $line = decode($enc, $line);
add blame method
Yuki Kimoto authored on 2013-08-10
240
    chomp $line;
241
    
242
    if ($blame_line) {
243
      if ($line =~ /^author +(.+)/) {
244
        $blame_line->{author} = $1;
245
      }
246
      elsif ($line =~ /^author-mail +(.+)/) {
fix mail bug
Yuki Kimoto authored on 2016-04-21
247
        $blame_line->{author_email} = $1;
add blame method
Yuki Kimoto authored on 2013-08-10
248
      }
improve blame design
Yuki Kimoto authored on 2013-08-10
249
      elsif ($line =~ /^author-time +(.+)/) {
250
        my $author_time = $1;
add hot color to blame page
Yuki Kimoto authored on 2013-08-10
251
        $blame_line->{author_time} = $author_time;
252
        $max_author_time = $author_time if !$max_author_time || $author_time > $max_author_time;
253
        $min_author_time = $author_time if !$min_author_time || $author_time < $min_author_time;
improve blame design
Yuki Kimoto authored on 2013-08-10
254
        my $author_age_string_date = $self->_age_string_date($author_time);
255
        $blame_line->{author_age_string_date} = $author_age_string_date;
improve blame page design
Yuki Kimoto authored on 2016-01-13
256
        my $author_age_string_date_local = $self->_age_string_date_local($author_time);
257
        $blame_line->{author_age_string_date_local} = $author_age_string_date_local;
improve blame design
Yuki Kimoto authored on 2013-08-10
258
      }
add blame method
Yuki Kimoto authored on 2013-08-10
259
      elsif ($line =~ /^summary +(.+)/) {
260
        $blame_line->{summary} = $1;
261
      }
262
      elsif ($line =~ /^\t(.+)?/) {
263
        my $content = $1;
264
        $content = '' unless defined $content;
265
        $blame_line->{content} = $content;
266
        push @$blame_lines, $blame_line;
267
        $blame_line = undef;
268
      }
269
    }
270
    elsif ($line =~ /^([a-fA-F0-9]{40}) +\d+ +(\d+)/) {
271
      $blame_line = {};
272
      $blame_line->{commit} = $1;
improve blame design
Yuki Kimoto authored on 2013-08-10
273
      $blame_line->{number} = $2;
add blame method
Yuki Kimoto authored on 2013-08-10
274
      if ($blame_lines->[-1]
275
        && $blame_lines->[-1]{commit} eq $blame_line->{commit})
276
      {
277
        $blame_line->{before_same_commit} = 1;
278
      }
279
    }
280
  }
281
  
add hot color to blame page
Yuki Kimoto authored on 2013-08-10
282
  my $blame = {
283
    lines => $blame_lines,
284
    max_author_time => $max_author_time,
285
    min_author_time => $min_author_time
286
  };
287
  
288
  return $blame;
add blame method
Yuki Kimoto authored on 2013-08-10
289
}
290

            
291
sub blob {
cleanup
Yuki Kimoto authored on 2016-04-16
292
  my ($self, $rep_info, $rev, $file) = @_;
add blame method
Yuki Kimoto authored on 2013-08-10
293
  
294
  # Blob
cleanup method
Yuki Kimoto authored on 2016-04-16
295
  my $hash = $self->path_to_hash($rep_info, $rev, $file, 'blob')
add blame method
Yuki Kimoto authored on 2013-08-10
296
    or croak 'Cannot find file';
cleanup blob
Yuki Kimoto authored on 2016-04-16
297
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
298
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
299
    'cat-file',
300
    'blob',
301
    $hash
add blame method
Yuki Kimoto authored on 2013-08-10
302
  );
303
  open my $fh, '-|', @cmd
304
    or croak "Can't cat $file, $hash";
305
  
306
  # Format lines
cleanup encoding
Yuki Kimoto authored on 2016-04-05
307
  my @lines = <$fh>;
308
  my @new_lines;
cleanup methods
Yuki Kimoto authored on 2016-04-16
309
  my $enc = $self->decide_encoding($rep_info, \@lines);
cleanup encoding
Yuki Kimoto authored on 2016-04-05
310
  for my $line (@lines) {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
311
    $line = decode($enc, $line);
add blame method
Yuki Kimoto authored on 2013-08-10
312
    chomp $line;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
313
    push @new_lines, $line;
add blame method
Yuki Kimoto authored on 2013-08-10
314
  }
315
  
cleanup encoding
Yuki Kimoto authored on 2016-04-05
316
  return \@new_lines;
add blame method
Yuki Kimoto authored on 2013-08-10
317
}
318

            
cleanup
Yuki Kimoto authored on 2013-05-14
319
sub blob_diffs {
cleanup
Yuki Kimoto authored on 2016-04-16
320
  my ($self, $rep_info, $rev1, $rev2, $diff_trees, $opt) = @_;
cleanup blob_diffs
Yuki Kimoto authored on 2016-04-16
321
  
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
322
  $opt //= {};
323
  my $ignore_space_change = $opt->{ignore_space_change};
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
324
  
cleanup
Yuki Kimoto authored on 2013-05-14
325
  return unless defined $rev1 && defined $rev2;
added commit page test
Yuki Kimoto authored on 2013-04-27
326
  
cleanup
Yuki Kimoto authored on 2013-05-14
327
  # Diff tree
cleanup blob_diffs
Yuki Kimoto authored on 2016-04-16
328
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
329
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
330
    'diff-tree',
331
    '-r',
332
    '-M',
333
    '--no-commit-id',
334
    '--patch-with-raw',
335
    ($ignore_space_change ? '--ignore-space-change' : ()),
336
    $rev1,
337
    $rev2,
338
    '--'
cleanup
Yuki Kimoto authored on 2013-03-19
339
  );
add --ignore-space-change fe...
Yuki Kimoto authored on 2014-12-09
340
  
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
341
  open my $fh, '-|', @cmd
342
    or croak('Open self-diff-tree failed');
cleanup
Yuki Kimoto authored on 2013-05-14
343
  my @diff_tree;
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
344
  my @diff_tree_lines = <$fh>;
cleanup methods
Yuki Kimoto authored on 2016-04-16
345
  my $diff_tree_enc = $self->decide_encoding($rep_info, \@diff_tree_lines);
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
346
  for my $line (@diff_tree_lines) {
347
    $line = decode($diff_tree_enc, $line);
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
348
    chomp $line;
cleanup
Yuki Kimoto authored on 2013-05-14
349
    push @diff_tree, $line if $line =~ /^:/;
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
350
    last if $line =~ /^\n/;
351
  }
352
  close $fh;
cleanup
Yuki Kimoto authored on 2013-05-14
353
  
354
  # Blob diffs
cleanup
Yuki Kimoto authored on 2013-05-14
355
  my $blob_diffs = [];
cleanup
Yuki Kimoto authored on 2013-05-14
356
  for my $line (@diff_tree) {
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
357
  
cleanup
Yuki Kimoto authored on 2013-05-14
358
    # File information
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
359
    chomp $line;
cleanup
Yuki Kimoto authored on 2013-05-14
360
    my $diffinfo = $self->parse_diff_tree_line($line);
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
361
    my $from_file = $diffinfo->{from_file};
362
    my $file = $diffinfo->{to_file};
363
    
cleanup
Yuki Kimoto authored on 2013-05-14
364
    # Blob diff
cleanup blob_diffs
Yuki Kimoto authored on 2016-04-16
365
    my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
366
      $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
367
      'diff-tree',
368
      '-r',
369
      '-M',
370
      '-p',
371
      ($ignore_space_change ? '--ignore-space-change' : ()),
372
      $rev1,
373
      $rev2,
374
      '--',
375
      (defined $from_file ? $from_file : ()),
376
      $file
cleanup
Yuki Kimoto authored on 2013-03-19
377
    );
cleanup
Yuki Kimoto authored on 2013-05-14
378
    open my $fh, '-|', @cmd
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
379
      or croak('Open self-diff-tree failed');
cleanup encoding
Yuki Kimoto authored on 2016-04-05
380
    my @lines = <$fh>;
cleanup methods
Yuki Kimoto authored on 2016-04-16
381
    my $enc = $self->decide_encoding($rep_info, \@lines);
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
382
    @lines = map { decode($enc, $_) } @lines;
cleanup
Yuki Kimoto authored on 2013-05-14
383
    close $fh;
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
384
    my ($lines, $diff_info) = $self->parse_blob_diff_lines(\@lines);
cleanup
Yuki Kimoto authored on 2013-05-14
385
    my $blob_diff = {
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
386
      file => $file,
387
      from_file => $from_file,
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
388
      lines => $lines,
389
      add_line_count => $diff_info->{add_line_count},
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
390
      delete_line_count => $diff_info->{delete_line_count},
391
      binary => $diff_info->{binary}
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
392
    };
393
    
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
394
    # Diff tree info
cleanup
Yuki Kimoto authored on 2013-05-14
395
    for my $diff_tree (@$diff_trees) {
396
      if ($diff_tree->{to_file} eq $file) {
397
        $blob_diff->{status} = $diff_tree->{status};
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
398
        $diff_tree->{add_line_count} = $diff_info->{add_line_count};
399
        $diff_tree->{delete_line_count} = $diff_info->{delete_line_count};
400
        $diff_tree->{add_block_count} = $diff_info->{add_block_count};
401
        $diff_tree->{delete_block_count} = $diff_info->{delete_block_count};
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
402
        $diff_tree->{binary} = $diff_info->{binary};
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
403
        last;
404
      }
405
    }
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
406
    
cleanup
Yuki Kimoto authored on 2013-05-14
407
    push @$blob_diffs, $blob_diff;
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
408
  }
409
  
cleanup
Yuki Kimoto authored on 2013-05-14
410
  return $blob_diffs;
added compare page file chan...
Yuki Kimoto authored on 2013-02-07
411
}
412

            
binary data not shown
Yuki Kimoto authored on 2013-06-02
413
sub blob_is_image {
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
414
  my $self = shift;
binary data not shown
Yuki Kimoto authored on 2013-06-02
415
  
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
416
  my $mime_type = $self->blob_mime_type(@_);
binary data not shown
Yuki Kimoto authored on 2013-06-02
417
  
418
  return ($mime_type || '') =~ m#^image/#;
419
}
420

            
cleanup
Yuki Kimoto authored on 2013-05-14
421
sub blob_mime_type {
cleanup
Yuki Kimoto authored on 2016-04-16
422
  my ($self, $rep_info, $rev, $file) = @_;
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
423
  
cleanup
Yuki Kimoto authored on 2013-05-14
424
  # Blob
cleanup method
Yuki Kimoto authored on 2016-04-16
425
  my $hash = $self->path_to_hash($rep_info, $rev, $file, 'blob')
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
426
    or croak 'Cannot find file';
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
427
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
428
    $rep_info,
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
429
    'cat-file',
430
    'blob',
cleanup
Yuki Kimoto authored on 2013-05-14
431
    $hash
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
432
  );
433
  open my $fh, '-|', @cmd
cleanup
Yuki Kimoto authored on 2013-05-14
434
    or croak "Can't cat $file, $hash";
copy gitweblite soruce code
root authored on 2012-11-23
435

            
436
  return 'text/plain' unless $fh;
437
  
438
  # MIME type
439
  my $text_exts = $self->text_exts;
440
  for my $text_ext (@$text_exts) {
441
    my $ext = quotemeta($text_ext);
442
    return 'text/plain' if $file =~ /\.$ext$/i;
443
  }
444
  if (-T $fh) { return 'text/plain' }
445
  elsif (! $file) { return 'application/octet-stream' }
446
  elsif ($file =~ m/\.png$/i) { return 'image/png' }
447
  elsif ($file =~ m/\.gif$/i) { return 'image/gif' }
448
  elsif ($file =~ m/\.jpe?g$/i) { return 'image/jpeg'}
449
  else { return 'application/octet-stream'}
450
  
451
  return;
452
}
453

            
cleanup
Yuki Kimoto authored on 2013-05-14
454
sub blob_content_type {
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
455
  my $self = shift;
copy gitweblite soruce code
root authored on 2012-11-23
456
  
457
  # Content type
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
458
  my $type = $self->blob_mime_type(@_);
copy gitweblite soruce code
root authored on 2012-11-23
459
  if ($type eq 'text/plain') {
Renamed encoding to default_...
Tetsuya Hayashi authored on 2014-03-15
460
    $type .= "; charset=" . $self->default_encoding;
copy gitweblite soruce code
root authored on 2012-11-23
461
  }
462

            
463
  return $type;
464
}
465

            
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
466
sub blob_mode {
cleanup
Yuki Kimoto authored on 2016-04-16
467
  my ($self, $rep_info, $rev, $file) = @_;
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
468
  
cleanup
Yuki Kimoto authored on 2013-05-14
469
  # Blob mode
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
470
  $file =~ s#/+$##;
cleanup blob_mode
Yuki Kimoto authored on 2016-04-16
471
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
472
    $rep_info,
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
473
    'ls-tree',
474
    $rev,
475
    '--',
476
    $file
477
  );
478
  open my $fh, '-|', @cmd
479
    or croak 'Open git-ls-tree failed';
cleanup encoding
Yuki Kimoto authored on 2016-04-05
480
  my $line = <$fh>;
481
  $line = $self->_dec($line);
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
482
  close $fh or return;
483
  my ($mode) = ($line || '') =~ m/^([0-9]+) /;
484
  
485
  return $mode;
486
}
487

            
488
sub blob_raw {
cleanup
Yuki Kimoto authored on 2016-04-16
489
  my ($self, $rep_info, $rev, $path) = @_;
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
490
  
cleanup
Yuki Kimoto authored on 2013-05-14
491
  # Blob raw
cleanup
Yuki Kimoto authored on 2016-04-16
492
  my @cmd = $self->cmd($rep_info, 'cat-file', 'blob', "$rev:$path");
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
493
  open my $fh, "-|", @cmd
494
    or croak 500, "Open git-cat-file failed";
495
  local $/;
cleanup blob_raw
Yuki Kimoto authored on 2016-04-16
496
  my $blob_raw = <$fh>;
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
497

            
498
  close $fh or croak 'Reading git-shortlog failed';
499
  
500
  return $blob_raw;
501
}
502

            
cleanup
Yuki Kimoto authored on 2013-05-14
503
sub blob_size {
cleanup
Yuki Kimoto authored on 2016-04-16
504
  my ($self, $rep_info, $rev, $file) = @_;
added file size to blob page
Yuki Kimoto authored on 2013-01-29
505
  
cleanup
Yuki Kimoto authored on 2013-05-14
506
  # Blob size(KB)
cleanup blob_size
Yuki Kimoto authored on 2016-04-16
507
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
508
    $rep_info,
cleanup blob page
Yuki Kimoto authored on 2013-03-19
509
    'cat-file',
510
    '-s',
511
    "$rev:$file"
512
  );
added file size to blob page
Yuki Kimoto authored on 2013-01-29
513
  open my $fh, "-|", @cmd
514
    or croak 500, "Open cat-file failed";
cleanup encoding
Yuki Kimoto authored on 2016-04-05
515
  my $size = <$fh>;
516
  $size = $self->_dec($size);
added file size to blob page
Yuki Kimoto authored on 2013-01-29
517
  chomp $size;
518
  close $fh or croak 'Reading cat-file failed';
519
  
cleanup
Yuki Kimoto authored on 2013-05-14
520
  # Format
521
  my $size_f = sprintf('%.3f', $size / 1000);
522
  $size_f =~ s/0+$//;
improved blob page desing
Yuki Kimoto authored on 2013-05-02
523
  
cleanup
Yuki Kimoto authored on 2013-05-14
524
  return $size_f;
added file size to blob page
Yuki Kimoto authored on 2013-01-29
525
}
526

            
improved create repository f...
Yuki Kimoto authored on 2013-03-21
527
sub check_head_link {
528
  my ($self, $dir) = @_;
added separeted commit getti...
Yuki Kimoto authored on 2013-02-04
529
  
improved create repository f...
Yuki Kimoto authored on 2013-03-21
530
  # Chack head
531
  my $head_file = "$dir/HEAD";
532
  return ((-e $head_file) ||
533
    (-l $head_file && readlink($head_file) =~ /^refs\/heads\//));
534
}
added separeted commit getti...
Yuki Kimoto authored on 2013-02-04
535

            
added commits number
Yuki Kimoto authored on 2012-11-28
536
sub commits_number {
cleanup
Yuki Kimoto authored on 2016-04-16
537
  my ($self, $rep_info, $ref) = @_;
added commits number
Yuki Kimoto authored on 2012-11-28
538
  
539
  # Command "git diff-tree"
cleanup
Yuki Kimoto authored on 2016-04-16
540
  my @cmd = $self->cmd($rep_info, 'shortlog', '-s', $ref);
added commits number
Yuki Kimoto authored on 2012-11-28
541
  open my $fh, "-|", @cmd
542
    or croak 500, "Open git-shortlog failed";
cleanup encoding
Yuki Kimoto authored on 2016-04-05
543
  my @commits_infos = <$fh>;
544
  @commits_infos = map { chomp; $self->_dec($_) } @commits_infos;
added commits number
Yuki Kimoto authored on 2012-11-28
545
  close $fh or croak 'Reading git-shortlog failed';
546
  
547
  my $commits_num = 0;
548
  for my $commits_info (@commits_infos) {
549
    if ($commits_info =~ /^ *([0-9]+)/) {
550
      $commits_num += $1;
551
    }
552
  }
553
  
554
  return $commits_num;
555
}
556

            
cleanup
Yuki Kimoto authored on 2013-05-14
557
sub exists_branch {
cleanup merge and push logic
Yuki Kimoto authored on 2016-04-27
558
  my ($self, $rep_info, $branch_name) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
559
  
cleanup merge and push logic
Yuki Kimoto authored on 2016-04-27
560
  my $branch_names = $self->branch_names($rep_info);
561
  
562
  
563
  my $exists_branch;
564
  if (defined $branch_name) {
565
    $exists_branch = grep { $_ eq $branch_name } @$branch_names;
566
  }
567
  else {
568
    $exists_branch = @$branch_names ? 1 : 0;
569
  }
cleanup
Yuki Kimoto authored on 2013-05-14
570
  
cleanup merge and push logic
Yuki Kimoto authored on 2016-04-27
571
  return $exists_branch;
cleanup
Yuki Kimoto authored on 2013-05-14
572
}
573

            
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
574
sub delete_branch {
fix branches page pull reque...
Yuki Kimoto authored on 2016-04-26
575
  my ($self, $rep_info, $branch) = @_;
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
576
  
fix branches page pull reque...
Yuki Kimoto authored on 2016-04-26
577
  my $branches = $self->branches($rep_info);
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
578
  my $exists;
579
  for my $b (@$branches) {
580
    if ($branch eq $b->{name}) {
581
      $exists = 1;
582
      next;
583
    }
584
  }
585
  
586
  if ($exists) {
fix branches page pull reque...
Yuki Kimoto authored on 2016-04-26
587
    my @cmd = $self->cmd($rep_info, 'branch', '-D', $branch);
fix bug that in CGI reposito...
Yuki Kimoto authored on 2015-11-05
588
    Gitprep::Util::run_command(@cmd)
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
589
      or croak "Branch deleting failed. Can't delete branch $branch";
590
  }
591
  else {
592
    croak "Branch deleteting failed.. branchg $branch is not exists";
593
  }
594
}
595

            
added project rename feature
Yuki Kimoto authored on 2013-03-25
596
sub description {
fix branches page pull reque...
Yuki Kimoto authored on 2016-04-26
597
  my ($self, $rep_info, $description) = @_;
added project rename feature
Yuki Kimoto authored on 2013-03-25
598
  
fix branches page pull reque...
Yuki Kimoto authored on 2016-04-26
599
  my $git_dir = $rep_info->{git_dir};
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
600
  my $file = "$git_dir/description";
added project rename feature
Yuki Kimoto authored on 2013-03-25
601
  
602
  if (defined $description) {
603
    # Write description
604
    open my $fh, '>',$file
fix branches page pull reque...
Yuki Kimoto authored on 2016-04-26
605
      or croak "Can't open file $git_dir: $!";
added project rename feature
Yuki Kimoto authored on 2013-03-25
606
    print $fh encode('UTF-8', $description)
607
      or croak "Can't write description: $!";
608
    close $fh;
609
  }
610
  else {
611
    # Read description
added not exists repository ...
Yuki Kimoto authored on 2013-05-15
612
    return unless -f $file;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
613
    my $description = $self->_slurp($file) || '';
614
    $description = $self->_dec($description);
added project rename feature
Yuki Kimoto authored on 2013-03-25
615
    return $description;
616
  }
617
}
618

            
cleanup
Yuki Kimoto authored on 2013-05-14
619
sub diff_tree {
cleanup method
Yuki Kimoto authored on 2016-04-16
620
  my ($self, $rep_info, $rev, $parent, $opt) = @_;
add --ignore-space-change fe...
Yuki Kimoto authored on 2014-12-09
621
  
622
  $opt ||= {};
623
  my $ignore_space_change = $opt->{ignore_space_change};
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
624
  
copy gitweblite soruce code
root authored on 2012-11-23
625
  # Root
626
  $parent = '--root' unless defined $parent;
627

            
cleanup
Yuki Kimoto authored on 2013-03-19
628
  # Get diff tree
cleanup method
Yuki Kimoto authored on 2016-04-16
629
  my @cmd = $self->cmd(
630
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
631
    "diff-tree",
632
    '-r',
633
    '--no-commit-id',
634
    '-M',
add --ignore-space-change fe...
Yuki Kimoto authored on 2014-12-09
635
    ($ignore_space_change ? '--ignore-space-change' : ()),
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
636
    $parent,
637
    $rev,
cleanup
Yuki Kimoto authored on 2013-03-19
638
    '--'
639
  );
add --ignore-space-change fe...
Yuki Kimoto authored on 2014-12-09
640
  
copy gitweblite soruce code
root authored on 2012-11-23
641
  open my $fh, "-|", @cmd
642
    or croak 500, "Open git-diff-tree failed";
cleanup encoding
Yuki Kimoto authored on 2016-04-05
643
  my @diff_tree = <$fh>;
644
  @diff_tree = map { chomp; $self->_dec($_) } @diff_tree;
copy gitweblite soruce code
root authored on 2012-11-23
645
  close $fh or croak 'Reading git-diff-tree failed';
646
  
647
  # Parse "git diff-tree" output
648
  my $diffs = [];
cleanup
Yuki Kimoto authored on 2013-05-14
649
  for my $line (@diff_tree) {
650
    my $diff = $self->parsed_diff_tree_line($line);
copy gitweblite soruce code
root authored on 2012-11-23
651
    
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
652
    my ($to_mode_oct, $to_mode_str, $to_file_type);
653
    my ($from_mode_oct, $from_mode_str, $from_file_type);
654
    if ($diff->{to_mode} ne ('0' x 6)) {
655
      $to_mode_oct = oct $diff->{to_mode};
656
      if (S_ISREG($to_mode_oct)) { # only for regular file
657
        $to_mode_str = sprintf('%04o', $to_mode_oct & 0777); # permission bits
copy gitweblite soruce code
root authored on 2012-11-23
658
      }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
659
      $to_file_type = $self->file_type($diff->{to_mode});
660
    }
661
    if ($diff->{from_mode} ne ('0' x 6)) {
662
      $from_mode_oct = oct $diff->{from_mode};
663
      if (S_ISREG($from_mode_oct)) { # only for regular file
664
        $from_mode_str = sprintf('%04o', $from_mode_oct & 0777); # permission bits
copy gitweblite soruce code
root authored on 2012-11-23
665
      }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
666
      $from_file_type = $self->file_type($diff->{from_mode});
copy gitweblite soruce code
root authored on 2012-11-23
667
    }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
668
    
669
    $diff->{to_mode_str} = $to_mode_str;
670
    $diff->{to_mode_oct} = $to_mode_oct;
671
    $diff->{to_file_type} = $to_file_type;
672
    $diff->{from_mode_str} = $from_mode_str;
673
    $diff->{from_mode_oct} = $from_mode_oct;
674
    $diff->{from_file_type} = $from_file_type;
675

            
676
    push @$diffs, $diff;
copy gitweblite soruce code
root authored on 2012-11-23
677
  }
678
  
679
  return $diffs;
680
}
681

            
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
682
sub file_type {
683
  my ($self, $mode) = @_;
684
  
685
  # File type
686
  if ($mode !~ m/^[0-7]+$/) { return $mode }
687
  else { $mode = oct $mode }
688
  if ($self->_s_isgitlink($mode)) { return 'submodule' }
689
  elsif (S_ISDIR($mode & S_IFMT)) { return 'directory' }
690
  elsif (S_ISLNK($mode)) { return 'symlink' }
691
  elsif (S_ISREG($mode)) { return 'file' }
692
  else { return 'unknown' }
693
  
694
  return
695
}
696

            
697
sub file_type_long {
698
  my ($self, $mode) = @_;
699
  
cleanup
Yuki Kimoto authored on 2013-05-14
700
  # File type long
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
701
  if ($mode !~ m/^[0-7]+$/) { return $mode }
702
  else { $mode = oct $mode }
703
  if ($self->_s_isgitlink($mode)) { return 'submodule' }
704
  elsif (S_ISDIR($mode & S_IFMT)) { return 'directory' }
705
  elsif (S_ISLNK($mode)) { return 'symlink' }
706
  elsif (S_ISREG($mode)) {
707
    if ($mode & S_IXUSR) { return 'executable file' }
708
    else { return 'file' }
709
  }
710
  else { return 'unknown' }
711
  
712
  return;
713
}
714

            
cleanup
Yuki Kimoto authored on 2013-05-14
715
sub forward_commits {
fix compare page from forke...
Yuki Kimoto authored on 2016-08-20
716
  my ($self, $work_rep_info, $base_rep_info, $base_branch, $target_rep_info, $target_branch) = @_;
717

            
718
  my $target_object_id = $self->app->git->ref_to_object_id($target_rep_info, $target_branch);
719

            
cleanup
Yuki Kimoto authored on 2013-05-14
720
  # Forwarding commits
cleanup method
Yuki Kimoto authored on 2016-04-16
721
  my @cmd = $self->cmd(
fix compare page from forke...
Yuki Kimoto authored on 2016-08-20
722
    $work_rep_info,
cleanup
Yuki Kimoto authored on 2013-05-14
723
    'rev-list',
724
    '--left-right',
fix compare page from forke...
Yuki Kimoto authored on 2016-08-20
725
    "$base_branch...$target_object_id"
cleanup
Yuki Kimoto authored on 2013-05-14
726
  );
727
  open my $fh, '-|', @cmd
728
    or croak "Can't get info: @cmd";
729
  my $commits = [];
730
  while (my $line = <$fh>) {
731
    if ($line =~ /^>(.+)\s/) {
732
      my $rev = $1;
fix compare page from forke...
Yuki Kimoto authored on 2016-08-20
733
      my $commit = $self->get_commit($work_rep_info, $rev);
cleanup
Yuki Kimoto authored on 2013-05-14
734
      push @$commits, $commit;
added merged branches to bra...
Yuki Kimoto authored on 2013-05-03
735
    }
736
  }
737
  
cleanup
Yuki Kimoto authored on 2013-05-14
738
  return $commits;
added merged branches to bra...
Yuki Kimoto authored on 2013-05-03
739
}
740

            
cleanup
Yuki Kimoto authored on 2013-05-14
741
sub path_to_hash {
cleanup method
Yuki Kimoto authored on 2016-04-16
742
  my ($self, $rep_info, $rev, $path, $type) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
743
  
744
  # Get blob id or tree id (command "git ls-tree")
745
  $path =~ s#/+$##;
cleanup method
Yuki Kimoto authored on 2016-04-16
746
  my @cmd = $self->cmd(
747
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
748
    'ls-tree',
cleanup
Yuki Kimoto authored on 2013-04-29
749
    $rev,
cleanup
Yuki Kimoto authored on 2013-03-19
750
    '--',
751
    $path
752
  );
copy gitweblite soruce code
root authored on 2012-11-23
753
  open my $fh, '-|', @cmd
754
    or croak 'Open git-ls-tree failed';
cleanup encoding
Yuki Kimoto authored on 2016-04-05
755
  my $line = <$fh>;
756
  $line = $self->_dec($line);
copy gitweblite soruce code
root authored on 2012-11-23
757
  close $fh or return;
758
  my ($t, $id) = ($line || '') =~ m/^[0-9]+ (.+) ([0-9a-fA-F]{40})\t/;
change markdown engine to Te...
Yuki Kimoto authored on 2013-10-07
759
  $t ||= '';
copy gitweblite soruce code
root authored on 2012-11-23
760
  return if defined $type && $type ne $t;
761

            
762
  return $id;
763
}
764

            
cleanup
Yuki Kimoto authored on 2013-05-14
765
sub last_activity {
cleanup method
Yuki Kimoto authored on 2016-04-16
766
  my ($self, $rep) = @_;
added branch and tag refs to...
Yuki Kimoto authored on 2013-04-26
767
  
cleanup
Yuki Kimoto authored on 2013-05-14
768
  # Command "git for-each-ref"
cleanup method
Yuki Kimoto authored on 2016-04-16
769
  my @cmd = $self->cmd(
770
    $rep,
cleanup
Yuki Kimoto authored on 2013-05-14
771
    'for-each-ref',
772
    '--format=%(committer)',
773
    '--sort=-committerdate',
774
    '--count=1', 'refs/heads'
added branch and tag refs to...
Yuki Kimoto authored on 2013-04-26
775
  );
cleanup
Yuki Kimoto authored on 2013-05-14
776
  open my $fh, '-|', @cmd or return;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
777
  my $most_recent = <$fh>;
778
  $most_recent = $self->_dec($most_recent);
cleanup
Yuki Kimoto authored on 2013-05-14
779
  close $fh or return;
added branch and tag refs to...
Yuki Kimoto authored on 2013-04-26
780
  
cleanup
Yuki Kimoto authored on 2013-05-14
781
  # Parse most recent
782
  if (defined $most_recent &&
783
      $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
784
    my $timestamp = $1;
785
    my $age = time - $timestamp;
786
    return ($age, $self->_age_string($age));
added branch and tag refs to...
Yuki Kimoto authored on 2013-04-26
787
  }
788
  
cleanup
Yuki Kimoto authored on 2013-05-14
789
  return;
790
}
791

            
792
sub parse_rev_path {
cleanup tags
Yuki Kimoto authored on 2016-04-16
793
  my ($self, $rep_info, $rev_path) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
794
  
cleanup
Yuki Kimoto authored on 2013-05-14
795
  # References
cleanup parse_rev_path
Yuki Kimoto authored on 2016-04-16
796
  my @cmd = $self->cmd(
cleanup tags
Yuki Kimoto authored on 2016-04-16
797
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-05-14
798
    'show-ref',
799
    '--dereference'
cleanup
Yuki Kimoto authored on 2013-03-19
800
  );
cleanup
Yuki Kimoto authored on 2013-05-14
801
  open my $fh, '-|', @cmd
802
    or return;
803
  my $refs = [];
cleanup encoding
Yuki Kimoto authored on 2016-04-05
804
  my @lines = <$fh>;
805
  for my $line (@lines) {
806
    $line = $self->_dec($line);
cleanup
Yuki Kimoto authored on 2013-05-14
807
    chomp $line;
808
    if ($line =~ m!^[0-9a-fA-F]{40}\s(refs/((?:heads|tags)/(.*)))$!) {
809
      push @$refs, $1, $2, $3;
810
    }
811
  }
copy gitweblite soruce code
root authored on 2012-11-23
812
  close $fh or return;
813
  
cleanup
Yuki Kimoto authored on 2013-05-14
814
  @$refs = sort {
815
    my @a_match = $a =~ /(\/)/g;
816
    my @b_match = $b =~ /(\/)/g;
817
    scalar @b_match <=> scalar @a_match;
818
  } @$refs;
819
  
820
  for my $ref (@$refs) {
821
    $rev_path =~ m#/$#;
822
    if ($rev_path =~ m#^(\Q$ref\E)/(.+)#) {
823
      my $rev = $1;
824
      my $path = $2;
825
      return ($rev, $path);
826
    }
827
    elsif ($rev_path eq $ref) {
828
      return ($rev_path, '');
829
    }
copy gitweblite soruce code
root authored on 2012-11-23
830
  }
831
  
cleanup
Yuki Kimoto authored on 2013-05-14
832
  if ($rev_path) {
833
    my ($rev, $path) = split /\//, $rev_path, 2;
834
    $path = '' unless defined $path;
835
    return ($rev, $path);
836
  }
837

            
copy gitweblite soruce code
root authored on 2012-11-23
838
  return;
839
}
840

            
841
sub object_type {
cleanup tags
Yuki Kimoto authored on 2016-04-16
842
  my ($self, $rep_info, $rev) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
843
  
cleanup
Yuki Kimoto authored on 2013-03-19
844
  # Get object type
cleanup tags
Yuki Kimoto authored on 2016-04-16
845
  my @cmd = $self->cmd(
846
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
847
    'cat-file',
848
    '-t',
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
849
    $rev
cleanup
Yuki Kimoto authored on 2013-03-19
850
  );
copy gitweblite soruce code
root authored on 2012-11-23
851
  open my $fh, '-|', @cmd  or return;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
852
  my $type = <$fh>;
853
  $type = $self->_dec($type);
copy gitweblite soruce code
root authored on 2012-11-23
854
  close $fh or return;
855
  chomp $type;
856
  
857
  return $type;
858
}
859

            
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
860
sub repository {
cleanup tags
Yuki Kimoto authored on 2016-04-16
861
  my ($self, $rep_info) = @_;
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
862

            
cleanup
Yuki Kimoto authored on 2016-04-16
863
  return unless -d $rep_info->{git_dir};
Fixed repositories page
Yuki Kimoto authored on 2012-11-23
864
  
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
865
  my $rep = {};
cleanup tags
Yuki Kimoto authored on 2016-04-16
866
  my @activity = $self->last_activity($rep_info);
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
867
  if (@activity) {
868
    $rep->{age} = $activity[0];
869
    $rep->{age_string} = $activity[1];
Fixed repositories page
Yuki Kimoto authored on 2012-11-23
870
  }
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
871
  else { $rep->{age} = 0 }
872
  
cleanup tags
Yuki Kimoto authored on 2016-04-16
873
  my $description = $self->description($rep_info) || '';
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
874
  $rep->{description} = $self->_chop_str($description, 25, 5);
cleanup
Yuki Kimoto authored on 2013-03-19
875
  
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
876
  return $rep;
Fixed repositories page
Yuki Kimoto authored on 2012-11-23
877
}
878

            
cleanup
Yuki Kimoto authored on 2013-05-14
879
sub references {
cleanup tags
Yuki Kimoto authored on 2016-04-16
880
  my ($self, $rep_info, $type) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
881
  
882
  $type ||= '';
883
  
884
  # Branches or tags
cleanup tags
Yuki Kimoto authored on 2016-04-16
885
  my @cmd = $self->cmd(
886
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-05-14
887
    'show-ref',
888
    '--dereference',
889
    (
890
      $type eq 'heads' ? ('--heads') :
891
      $type eq 'tags' ? ('--tags') :
892
      ()
893
    )
894
  );
895
  
896
  open my $fh, '-|', @cmd
897
    or return;
898
  
899
  # Parse references
900
  my %refs;
901
  my $type_re = $type ? $type : '(?:heads|tags)';
cleanup encoding
Yuki Kimoto authored on 2016-04-05
902
  my @lines = <$fh>;
903
  for my $line (@lines) {
904
    $line = $self->_dec($line);
cleanup
Yuki Kimoto authored on 2013-05-14
905
    chomp $line;
906
    if ($line =~ m!^([0-9a-fA-F]{40})\srefs/$type_re/(.*)$!) {
improved tag and branch refe...
Yuki Kimoto authored on 2013-06-03
907
      my $rev = $1;
908
      my $ref = $2;
909
      $ref =~ s/\^\{\}//;
910
      if (defined $refs{$rev}) { push @{$refs{$rev}}, $ref }
911
      else { $refs{$rev} = [$ref] }
cleanup
Yuki Kimoto authored on 2013-05-14
912
    }
913
  }
914
  close $fh or return;
915
  
916
  return \%refs;
917
}
918

            
copy gitweblite soruce code
root authored on 2012-11-23
919
sub short_id {
920
  my ($self, $project) = (shift, shift);
921
  
922
  # Short id
923
  return $self->id($project, @_, '--short=7');
924
}
925

            
improved tag page design
Yuki Kimoto authored on 2013-05-01
926
sub tags_count {
cleanup methods
Yuki Kimoto authored on 2016-04-16
927
  my ($self, $rep_info) = @_;
improved tag page design
Yuki Kimoto authored on 2013-05-01
928
  
929
  my $limit = 1000;
930
  
931
  # Get tags
cleanup methods
Yuki Kimoto authored on 2016-04-16
932
  my @cmd = $self->cmd(
933
    $rep_info,
improved tag page design
Yuki Kimoto authored on 2013-05-01
934
    'for-each-ref',
935
    ($limit ? '--count='.($limit+1) : ()),
936
    'refs/tags'
937
  );
938
  open my $fh, '-|', @cmd or return;
939
  
940
  # Tags count
941
  my @lines = <$fh>;
942
  
943
  return scalar @lines;
944
}
945

            
copy gitweblite soruce code
root authored on 2012-11-23
946
sub tags {
cleanup tags
Yuki Kimoto authored on 2016-04-16
947
  my ($self, $rep_info, $limit, $count, $offset) = @_;
improved tag page design
Yuki Kimoto authored on 2013-05-01
948
  
949
  $limit ||= 1000;
950
  $count ||= 50;
951
  $offset ||= 0;
cleanup
Yuki Kimoto authored on 2013-03-19
952
  
953
  # Get tags
cleanup tags
Yuki Kimoto authored on 2016-04-16
954
  my @cmd = $self->cmd(
955
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
956
    'for-each-ref',
957
    ($limit ? '--count='.($limit+1) : ()),
958
    '--sort=-creatordate',
959
    '--format=%(objectname) %(objecttype) %(refname) '
960
      . '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
961
    'refs/tags'
962
  );
copy gitweblite soruce code
root authored on 2012-11-23
963
  open my $fh, '-|', @cmd or return;
964
  
improved tag page design
Yuki Kimoto authored on 2013-05-01
965
  
copy gitweblite soruce code
root authored on 2012-11-23
966
  # Parse Tags
967
  my @tags;
improved tag page design
Yuki Kimoto authored on 2013-05-01
968
  my $line_num = 1;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
969
  my @lines = <$fh>;
970
  for my $line (@lines) {
971
    $line = $self->_dec($line);
copy gitweblite soruce code
root authored on 2012-11-23
972
    
improved tag page design
Yuki Kimoto authored on 2013-05-01
973
    if ($line_num > $offset && $line_num < $offset + $count + 1) {
974
    
975
      my %tag;
976

            
977
      chomp $line;
978
      my ($refinfo, $creatorinfo) = split(/\0/, $line);
979
      my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
980
      my ($creator, $epoch, $tz) =
981
        ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
982
      $tag{fullname} = $name;
983
      $name =~ s!^refs/tags/!!;
984

            
985
      $tag{type} = $type;
986
      $tag{id} = $id;
987
      $tag{name} = $name;
988
      if ($type eq 'tag') {
989
        $tag{subject} = $title;
990
        $tag{reftype} = $reftype;
991
        $tag{refid}   = $refid;
copy gitweblite soruce code
root authored on 2012-11-23
992
      } else {
improved tag page design
Yuki Kimoto authored on 2013-05-01
993
        $tag{reftype} = $type;
994
        $tag{refid}   = $id;
copy gitweblite soruce code
root authored on 2012-11-23
995
      }
996

            
improved tag page design
Yuki Kimoto authored on 2013-05-01
997
      if ($type eq 'tag' || $type eq 'commit') {
998
        $tag{epoch} = $epoch;
999
        if ($epoch) {
1000
          $tag{age} = $self->_age_string(time - $tag{epoch});
1001
        } else {
1002
          $tag{age} = 'unknown';
1003
        }
1004
      }
1005
      
1006
      $tag{comment_short} = $self->_chop_str($tag{subject}, 30, 5)
1007
        if $tag{subject};
1008

            
cleanup methods
Yuki Kimoto authored on 2016-04-16
1009
      $tag{commit} = $self->get_commit($rep_info, $name);
improved tag page design
Yuki Kimoto authored on 2013-05-01
1010

            
1011
      push @tags, \%tag;
1012
    }
1013
    $line_num++;
copy gitweblite soruce code
root authored on 2012-11-23
1014
  }
improved tag page design
Yuki Kimoto authored on 2013-05-01
1015
  
copy gitweblite soruce code
root authored on 2012-11-23
1016
  close $fh;
1017

            
1018
  return \@tags;
1019
}
1020

            
improved project page design
Yuki Kimoto authored on 2013-04-29
1021
sub last_change_commit {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1022
  my ($self, $rep_info, $rev, $file) = @_;
improved project page design
Yuki Kimoto authored on 2013-04-29
1023
  
1024
  my $commit_log = {};
1025
  $file = '' unless defined $file;
1026
  
cleanup methods
Yuki Kimoto authored on 2016-04-16
1027
  my @cmd = $self->cmd(
1028
    $rep_info,
improved project page design
Yuki Kimoto authored on 2013-04-29
1029
    '--no-pager',
1030
    'log',
1031
    '-n',
1032
    '1',
1033
    '--pretty=format:%H', 
1034
    $rev,
1035
    '--',
1036
    $file
1037
  );
1038
  open my $fh, '-|', @cmd
1039
    or croak 'Open git-log failed';
1040
  
1041
  local $/;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
1042
  my $commit_log_text = <$fh>;
1043
  $commit_log_text = $self->_dec($commit_log_text);
improved project page design
Yuki Kimoto authored on 2013-04-29
1044
  
1045
  my $commit;
1046
  if ($commit_log_text =~ /^([0-9a-zA-Z]+)/) {
1047
    my $rev = $1;
cleanup methods
Yuki Kimoto authored on 2016-04-16
1048
    $commit = $self->get_commit($rep_info, $rev);
improved project page design
Yuki Kimoto authored on 2013-04-29
1049
  }
1050
  
1051
  return $commit;
1052
}
1053

            
cleanup
Yuki Kimoto authored on 2013-05-14
1054
sub parse_blob_diff_lines {
cleanup commit page
Yuki Kimoto authored on 2013-04-12
1055
  my ($self, $lines) = @_;
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1056

            
1057
  my $diff_info = {};
1058

            
added commit page
Yuki Kimoto authored on 2013-01-29
1059
  # Parse
1060
  my @lines;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1061
  my $next_before_line_num;
1062
  my $next_after_line_num;
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1063
  my $add_line_count = 0;
1064
  my $delete_line_count = 0;
cleanup commit page
Yuki Kimoto authored on 2013-04-12
1065
  for my $line (@$lines) {
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1066
    
added commit page
Yuki Kimoto authored on 2013-01-29
1067
    chomp $line;
1068
    
improved commit page design
Yuki Kimoto authored on 2013-04-12
1069
    my $class;
cleanup commit page
Yuki Kimoto authored on 2013-04-12
1070
    my $before_line_num;
1071
    my $after_line_num;
improved commit page design
Yuki Kimoto authored on 2013-04-12
1072
    
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1073
    if ($line =~ /^@@\s-(\d+)(?:,\d+)?\s\+(\d+)/) {
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1074
      $next_before_line_num = $1;
1075
      $next_after_line_num = $2;
1076
      
1077
      $before_line_num = '...';
1078
      $after_line_num = '...';
1079
      
1080
      $class = 'chunk_header';
1081
    }
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1082
    elsif ($line =~ /^\+\+\+/ || $line =~ /^---/) { next }
1083
    elsif ($line =~ /^\-/) {
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1084
      $class = 'from_file';
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1085
      $before_line_num = $next_before_line_num++;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1086
      $after_line_num = '';
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1087
      $delete_line_count++;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1088
    }
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1089
    elsif ($line =~ /^\+/) {
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1090
      $class = 'to_file';
1091
      $before_line_num = '';
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1092
      $after_line_num = $next_after_line_num++;
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1093
      $add_line_count++;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1094
    }
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1095
    elsif ($line =~ /^Binary files/) {
1096
      $class = 'binary_file';
1097
      $diff_info->{binary} = 1;
1098
    }
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1099
    elsif ($line =~ /^ /) {
1100
      $class = 'diff';
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1101
      $before_line_num = $next_before_line_num++;
1102
      $after_line_num = $next_after_line_num++;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1103
    }
1104
    else { next }
cleanup commit page
Yuki Kimoto authored on 2013-04-12
1105
    
1106
    my $line_data = {
1107
      value => $line,
1108
      class => $class,
1109
      before_line_num => $before_line_num,
1110
      after_line_num => $after_line_num
1111
    };
1112
    push @lines, $line_data;
improved commit page design
Yuki Kimoto authored on 2013-04-12
1113
  }
1114
  
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1115
  # Diff info
1116
  my $diff_line_count = $add_line_count + $delete_line_count;
1117
  my $add_block_count
1118
    = $diff_line_count == 0
1119
    ? 0
1120
    : floor(($add_line_count * 5) / $diff_line_count);
1121
  my $delete_block_count
1122
    = $diff_line_count == 0
1123
    ? 0
1124
    : floor(($delete_line_count * 5) / $diff_line_count);
1125
  
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1126
  $diff_info->{add_line_count} = $add_line_count;
1127
  $diff_info->{delete_line_count} = $delete_line_count;
1128
  $diff_info->{add_block_count} = $add_block_count;
1129
  $diff_info->{delete_block_count} = $delete_block_count;
1130
  
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1131
  return (\@lines, $diff_info);
improved commit page design
Yuki Kimoto authored on 2013-04-12
1132
}
1133

            
rename parse_commit to get_c...
Yuki Kimoto authored on 2013-05-01
1134
sub get_commit {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1135
  my ($self, $rep_info, $id) = @_;
cleanup branch
Yuki Kimoto authored on 2016-04-16
1136
  
1137
  # Git rev-list
cleanup cmd
Yuki Kimoto authored on 2016-04-16
1138
  my @cmd = $self->cmd(
cleanup methods
Yuki Kimoto authored on 2016-04-16
1139
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
1140
    'rev-list',
1141
    '--parents',
1142
    '--header',
1143
    '--max-count=1',
1144
    $id,
1145
    '--'
cleanup branch
Yuki Kimoto authored on 2016-04-16
1146
  );
1147
  open my $fh, '-|', @cmd
1148
    or croak 'Open git-rev-list failed';
1149
  
1150
  # Parse commit
1151
  local $/ = "\0";
1152
  my $content = <$fh>;
1153
  $content = $self->_dec($content);
1154
  return unless defined $content;
1155
  my $commit = $self->parse_commit_text($content, 1);
copy gitweblite soruce code
root authored on 2012-11-23
1156
  close $fh;
1157

            
1158
  return $commit;
1159
}
1160

            
1161
sub parse_commit_text {
1162
  my ($self, $commit_text, $withparents) = @_;
1163
  
1164
  my @commit_lines = split '\n', $commit_text;
1165
  my %commit;
1166

            
1167
  pop @commit_lines; # Remove '\0'
1168
  return unless @commit_lines;
1169

            
1170
  my $header = shift @commit_lines;
1171
  return if $header !~ m/^[0-9a-fA-F]{40}/;
1172
  
1173
  ($commit{id}, my @parents) = split ' ', $header;
1174
  while (my $line = shift @commit_lines) {
1175
    last if $line eq "\n";
1176
    if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
1177
      $commit{tree} = $1;
1178
    } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
1179
      push @parents, $1;
1180
    } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
1181
      $commit{author} = $1;
1182
      $commit{author_epoch} = $2;
1183
      $commit{author_tz} = $3;
1184
      if ($commit{author} =~ m/^([^<]+) <([^>]*)>/) {
1185
        $commit{author_name}  = $1;
1186
        $commit{author_email} = $2;
1187
      } else {
1188
        $commit{author_name} = $commit{author};
1189
      }
1190
    } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
1191
      $commit{committer} = $1;
1192
      $commit{committer_epoch} = $2;
1193
      $commit{committer_tz} = $3;
1194
      if ($commit{committer} =~ m/^([^<]+) <([^>]*)>/) {
1195
        $commit{committer_name}  = $1;
1196
        $commit{committer_email} = $2;
1197
      } else {
1198
        $commit{committer_name} = $commit{committer};
1199
      }
1200
    }
1201
  }
1202
  return unless defined $commit{tree};
1203
  $commit{parents} = \@parents;
1204
  $commit{parent} = $parents[0];
1205

            
1206
  for my $title (@commit_lines) {
1207
    $title =~ s/^    //;
1208
    if ($title ne '') {
1209
      $commit{title} = $self->_chop_str($title, 80, 5);
1210
      # remove leading stuff of merges to make the interesting part visible
1211
      if (length($title) > 50) {
1212
        $title =~ s/^Automatic //;
1213
        $title =~ s/^merge (of|with) /Merge ... /i;
1214
        if (length($title) > 50) {
1215
          $title =~ s/(http|rsync):\/\///;
1216
        }
1217
        if (length($title) > 50) {
1218
          $title =~ s/(master|www|rsync)\.//;
1219
        }
1220
        if (length($title) > 50) {
1221
          $title =~ s/kernel.org:?//;
1222
        }
1223
        if (length($title) > 50) {
1224
          $title =~ s/\/pub\/scm//;
1225
        }
1226
      }
1227
      $commit{title_short} = $self->_chop_str($title, 50, 5);
1228
      last;
1229
    }
1230
  }
1231
  if (! defined $commit{title} || $commit{title} eq '') {
1232
    $commit{title} = $commit{title_short} = '(no commit message)';
1233
  }
1234
  # remove added spaces
1235
  for my $line (@commit_lines) {
1236
    $line =~ s/^    //;
1237
  }
1238
  $commit{comment} = \@commit_lines;
1239

            
1240
  my $age = time - $commit{committer_epoch};
1241
  $commit{age} = $age;
1242
  $commit{age_string} = $self->_age_string($age);
add time zone system
Yuki Kimoto authored on 2014-03-08
1243
  
1244
  # GMT
1245
  {
support atom feed of commits...
Yuki Kimoto authored on 2014-10-03
1246
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($commit{committer_epoch});
add time zone system
Yuki Kimoto authored on 2014-03-08
1247
    $commit{age_string_date} = sprintf '%4d-%02d-%02d', 1900 + $year, $mon + 1, $mday;
1248
    $commit{age_string_datetime} = sprintf '%4d-%02d-%02d %02d:%02d:%02d',
1249
      1900 + $year, $mon + 1, $mday, $hour, $min, $sec;
1250
  }
1251
  
1252
  # Local Time
1253
  {
1254
    my $time_zone_second = $self->time_zone_second || 0;
1255
    
support atom feed of commits...
Yuki Kimoto authored on 2014-10-03
1256
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($commit{committer_epoch} + $time_zone_second);
add time zone system
Yuki Kimoto authored on 2014-03-08
1257
    $commit{age_string_date_local}
1258
      = sprintf '%4d-%02d-%02d', 1900 + $year, $mon + 1, $mday;
support atom feed of commits...
Yuki Kimoto authored on 2014-10-03
1259
    $commit{age_string_datetime_local} = sprintf '%4d-%02d-%02d %02d:%02d:%02d',
add time zone system
Yuki Kimoto authored on 2014-03-08
1260
      1900 + $year, $mon + 1, $mday, $hour, $min, $sec;
1261
  }
support atom feed of commits...
Yuki Kimoto authored on 2014-10-03
1262

            
copy gitweblite soruce code
root authored on 2012-11-23
1263
  return \%commit;
1264
}
1265

            
cleanup
Yuki Kimoto authored on 2013-04-30
1266
sub get_commits {
cleanup import_branch
Yuki Kimoto authored on 2016-04-16
1267
  my ($self, $rep_info, $rev, $maxcount, $skip, $file, @args) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
1268

            
cleanup
Yuki Kimoto authored on 2013-03-19
1269
  # Get Commits
copy gitweblite soruce code
root authored on 2012-11-23
1270
  $maxcount ||= 1;
1271
  $skip ||= 0;
cleanup import_branch
Yuki Kimoto authored on 2016-04-16
1272
  my @cmd = $self->cmd(
1273
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
1274
    'rev-list',
1275
    '--header',
1276
    @args,
1277
    ('--max-count=' . $maxcount),
1278
    ('--skip=' . $skip),
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1279
    $rev,
cleanup
Yuki Kimoto authored on 2013-03-19
1280
    '--',
added branch long name featu...
Yuki Kimoto authored on 2013-05-12
1281
    (defined $file && length $file ? ($file) : ())
cleanup
Yuki Kimoto authored on 2013-03-19
1282
  );
copy gitweblite soruce code
root authored on 2012-11-23
1283
  open my $fh, '-|', @cmd
1284
    or croak 'Open git-rev-list failed';
cleanup
Yuki Kimoto authored on 2013-03-19
1285
  
1286
  # Prase Commits text
copy gitweblite soruce code
root authored on 2012-11-23
1287
  local $/ = "\0";
1288
  my @commits;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
1289
  my @lines = <$fh>;
1290
  for my $line (@lines) {
1291
    $line = $self->_dec($line);
copy gitweblite soruce code
root authored on 2012-11-23
1292
    my $commit = $self->parse_commit_text($line);
1293
    push @commits, $commit;
1294
  }
1295
  close $fh;
cleanup
Yuki Kimoto authored on 2013-03-19
1296
  
copy gitweblite soruce code
root authored on 2012-11-23
1297
  return \@commits;
1298
}
1299

            
1300
sub parse_date {
1301
  my $self = shift;
1302
  my $epoch = shift;
1303
  my $tz = shift || '-0000';
1304
  
1305
  # Parse data
1306
  my %date;
1307
  my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
1308
  my @days = qw/Sun Mon Tue Wed Thu Fri Sat/;
1309
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime $epoch;
1310
  $date{hour} = $hour;
1311
  $date{minute} = $min;
1312
  $date{mday} = $mday;
1313
  $date{day} = $days[$wday];
1314
  $date{month} = $months[$mon];
1315
  $date{rfc2822} = sprintf '%s, %d %s %4d %02d:%02d:%02d +0000',
1316
    $days[$wday], $mday, $months[$mon], 1900 + $year, $hour ,$min, $sec;
1317
  $date{'mday-time'} = sprintf '%d %s %02d:%02d',
1318
    $mday, $months[$mon], $hour ,$min;
1319
  $date{'iso-8601'}  = sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
1320
    1900 + $year, 1+$mon, $mday, $hour ,$min, $sec;
1321
  my ($tz_sign, $tz_hour, $tz_min) = ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
1322
  $tz_sign = ($tz_sign eq '-' ? -1 : +1);
1323
  my $local = $epoch + $tz_sign * ((($tz_hour*60) + $tz_min) * 60);
1324
  ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime $local;
1325
  $date{hour_local} = $hour;
1326
  $date{minute_local} = $min;
1327
  $date{tz_local} = $tz;
1328
  $date{'iso-tz'} = sprintf('%04d-%02d-%02d %02d:%02d:%02d %s',
1329
    1900 + $year, $mon+1, $mday, $hour, $min, $sec, $tz);
1330
  
1331
  return \%date;
1332
}
1333

            
cleanup
Yuki Kimoto authored on 2013-05-14
1334
sub parsed_diff_tree_line {
copy gitweblite soruce code
root authored on 2012-11-23
1335
  my ($self, $line) = @_;
1336
  
1337
  return $line if ref $line eq 'HASH';
1338

            
cleanup
Yuki Kimoto authored on 2013-05-14
1339
  return $self->parse_diff_tree_line($line);
copy gitweblite soruce code
root authored on 2012-11-23
1340
}
1341

            
cleanup
Yuki Kimoto authored on 2013-05-14
1342
sub parse_diff_tree_line {
copy gitweblite soruce code
root authored on 2012-11-23
1343
  my ($self, $line) = @_;
1344

            
1345
  my %res;
1346
  if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
1347
    $res{from_mode} = $1;
1348
    $res{to_mode} = $2;
1349
    $res{from_id} = $3;
1350
    $res{to_id} = $4;
1351
    $res{status} = $5;
1352
    $res{similarity} = $6;
1353
    if ($res{status} eq 'R' || $res{status} eq 'C') {
1354
      ($res{from_file}, $res{to_file}) = map { $self->_unquote($_) } split("\t", $7);
1355
    } else {
1356
      $res{from_file} = $res{to_file} = $res{file} = $self->_unquote($7);
1357
    }
1358
  }
1359
  elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
1360
    $res{nparents}  = length($1);
1361
    $res{from_mode} = [ split(' ', $2) ];
1362
    $res{to_mode} = pop @{$res{from_mode}};
1363
    $res{from_id} = [ split(' ', $3) ];
1364
    $res{to_id} = pop @{$res{from_id}};
1365
    $res{status} = [ split('', $4) ];
1366
    $res{to_file} = $self->_unquote($5);
1367
  }
1368
  elsif ($line =~ m/^([0-9a-fA-F]{40})$/) { $res{commit} = $1 }
1369

            
1370
  return \%res;
1371
}
1372

            
1373
sub parse_ls_tree_line {
1374
  my ($self, $line) = @_;
1375
  my %opts = @_;
1376
  my %res;
1377

            
1378
  if ($opts{'-l'}) {
1379
    $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
1380

            
1381
    $res{mode} = $1;
1382
    $res{type} = $2;
1383
    $res{hash} = $3;
1384
    $res{size} = $4;
1385
    if ($opts{'-z'}) { $res{name} = $5 }
1386
    else { $res{name} = $self->_unquote($5) }
1387
  }
1388
  else {
1389
    $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
1390

            
1391
    $res{mode} = $1;
1392
    $res{type} = $2;
1393
    $res{hash} = $3;
1394
    if ($opts{'-z'}) { $res{name} = $4 }
1395
    else { $res{name} = $self->_unquote($4) }
1396
  }
1397

            
1398
  return \%res;
1399
}
1400

            
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1401
sub import_branch {
cleanup import_branch
Yuki Kimoto authored on 2016-04-16
1402
  my ($self, $rep_info, $branch, $remote_rep_info, $remote_branch, $opt) = @_;
complete branch import featu...
Yuki Kimoto authored on 2013-08-15
1403
  
1404
  my $force = $opt->{force};
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1405
  
1406
  # Git pull
cleanup import_branch
Yuki Kimoto authored on 2016-04-16
1407
  my $remote_rep = $remote_rep_info->{git_dir};
1408
  my @cmd = $self->cmd(
1409
    $rep_info,
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1410
    'fetch',
1411
    $remote_rep,
complete branch import featu...
Yuki Kimoto authored on 2013-08-15
1412
    ($force ? '+' : '') . "refs/heads/$remote_branch:refs/heads/$branch"
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1413
  );
1414
  
fix bug that in CGI reposito...
Yuki Kimoto authored on 2015-11-05
1415
  Gitprep::Util::run_command(@cmd)
complete branch import featu...
Yuki Kimoto authored on 2013-08-15
1416
    or croak 'Open git fetch for import_branch failed';
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1417
}
1418

            
copy gitweblite soruce code
root authored on 2012-11-23
1419
sub search_bin {
1420
  my $self = shift;
1421
  
1422
  # Search git bin
1423
  my $env_path = $ENV{PATH};
1424
  my @paths = split /:/, $env_path;
1425
  for my $path (@paths) {
1426
    $path =~ s#/$##;
1427
    my $bin = "$path/git";
1428
    if (-f $bin) {
1429
      return $bin;
1430
      last;
1431
    }
1432
  }
improved git path searching
Yuki Kimoto authored on 2012-11-23
1433
  
1434
  my $local_bin = '/usr/local/bin/git';
1435
  return $local_bin if -f $local_bin;
1436
  
1437
  my $bin = '/usr/bin/git';
1438
  return $bin if -f $bin;
1439
  
copy gitweblite soruce code
root authored on 2012-11-23
1440
  return;
1441
}
1442

            
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1443
sub separated_commit {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1444
  my ($self, $rep_info, $rev1, $rev2) = @_;
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1445
  
1446
  # Command "git diff-tree"
cleanup methods
Yuki Kimoto authored on 2016-04-16
1447
  my @cmd = $self->cmd(
1448
    $rep_info,
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1449
    'show-branch',
1450
    $rev1,
1451
    $rev2
1452
  );
1453
  open my $fh, "-|", @cmd
1454
    or croak 500, "Open git-show-branch failed";
1455

            
1456
  my $commits = [];
1457
  my $start;
1458
  my @lines = <$fh>;
1459
  my $last_line = pop @lines;
1460
  my $commit;
1461
  if (defined $last_line) {
1462
      my ($id) = $last_line =~ /^.*?\[(.+)?\]/;
cleanup methods
Yuki Kimoto authored on 2016-04-16
1463
      $commit = $self->get_commit($rep_info, $id);
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1464
  }
1465

            
1466
  return $commit;
1467
}
1468

            
copy gitweblite soruce code
root authored on 2012-11-23
1469
sub snapshot_name {
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1470
  my ($self, $project, $rev) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
1471

            
1472
  my $name = $project;
1473
  $name =~ s,([^/])/*\.git$,$1,;
1474
  $name = basename($name);
1475
  # sanitize name
1476
  $name =~ s/[[:cntrl:]]/?/g;
1477

            
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1478
  my $ver = $rev;
1479
  if ($rev =~ /^[0-9a-fA-F]+$/) {
1480
    my $full_hash = $self->id($project, $rev);
1481
    if ($full_hash =~ /^$rev/ && length($rev) > 7) {
1482
      $ver = $self->short_id($project, $rev);
copy gitweblite soruce code
root authored on 2012-11-23
1483
    }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1484
  } elsif ($rev =~ m!^refs/tags/(.*)$!) {
copy gitweblite soruce code
root authored on 2012-11-23
1485
    $ver = $1;
1486
  } else {
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1487
    if ($rev =~ m!^refs/(?:heads|remotes)/(.*)$!) {
copy gitweblite soruce code
root authored on 2012-11-23
1488
      $ver = $1;
1489
    }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1490
    $ver .= '-' . $self->short_id($project, $rev);
copy gitweblite soruce code
root authored on 2012-11-23
1491
  }
1492
  $ver =~ s!/!.!g;
1493

            
1494
  $name = "$name-$ver";
1495

            
1496
  return wantarray ? ($name, $name) : $name;
1497
}
1498

            
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1499
sub timestamp {
1500
  my ($self, $date) = @_;
1501
  
1502
  # Time stamp
1503
  my $strtime = $date->{rfc2822};
1504
  my $localtime_format = '(%02d:%02d %s)';
1505
  if ($date->{hour_local} < 6) { $localtime_format = '(%02d:%02d %s)' }
1506
  $strtime .= ' ' . sprintf(
1507
    $localtime_format,
1508
    $date->{hour_local},
1509
    $date->{minute_local},
1510
    $date->{tz_local}
1511
  );
1512

            
1513
  return $strtime;
1514
}
1515

            
1516
sub trees {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1517
  my ($self, $rep_info, $rev, $dir) = @_;
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1518
  $dir = '' unless defined $dir;
1519
  
1520
  # Get tree
1521
  my $tid;
1522
  if (defined $dir && $dir ne '') {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1523
    $tid = $self->path_to_hash($rep_info, $rev, $dir, 'tree');
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1524
  }
1525
  else {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1526
    my $commit = $self->get_commit($rep_info, $rev);
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1527
    $tid = $commit->{tree};
1528
  }
1529
  my @entries = ();
1530
  my $show_sizes = 0;
cleanup methods
Yuki Kimoto authored on 2016-04-16
1531
  my @cmd = $self->cmd(
1532
    $rep_info,
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1533
    'ls-tree',
1534
    '-z',
1535
    ($show_sizes ? '-l' : ()),
1536
    $tid
1537
  );
1538
  open my $fh, '-|', @cmd
1539
    or $self->croak('Open git-ls-tree failed');
1540
  {
1541
    local $/ = "\0";
cleanup encoding
Yuki Kimoto authored on 2016-04-05
1542
    @entries = <$fh>;
1543
    @entries = map { chomp; $self->_dec($_) } @entries;
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1544
  }
1545
  close $fh
1546
    or $self->croak(404, "Reading tree failed");
1547

            
1548
  # Parse tree
1549
  my $trees;
1550
  for my $line (@entries) {
1551
    my $tree = $self->parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
1552
    $tree->{mode_str} = $self->_mode_str($tree->{mode});
1553
    
1554
    # Commit log
1555
    my $path = defined $dir && $dir ne '' ? "$dir/$tree->{name}" : $tree->{name};
cleanup methods
Yuki Kimoto authored on 2016-04-16
1556
    my $commit = $self->last_change_commit($rep_info, $rev, $path);
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1557
    $tree->{commit} = $commit;
1558
    
1559
    push @$trees, $tree;
1560
  }
1561
  $trees = [sort {$b->{type} cmp $a->{type} || $a->{name} cmp $b->{name}} @$trees];
1562
  
1563
  return $trees;
1564
}
1565

            
refactored
Xavier Caron authored on 2013-08-30
1566
sub _age_ago {
1567
  my($self,$unit,$age) = @_;
1568

            
does not use plural when uni...
Xavier Caron authored on 2013-08-30
1569
  return $age . " $unit" . ( $unit =~ /^(sec|min)$/ ? "" : ( $age > 1 ? "s" : "" ) ) . " ago";
refactored
Xavier Caron authored on 2013-08-30
1570
}
1571

            
copy gitweblite soruce code
root authored on 2012-11-23
1572
sub _age_string {
1573
  my ($self, $age) = @_;
1574
  my $age_str;
1575

            
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1576
  if ($age >= 60 * 60 * 24 * 365) {
refactored
Xavier Caron authored on 2013-08-30
1577
    $age_str = $self->_age_ago(year => (int $age/60/60/24/365));
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1578
  } elsif ($age >= 60 * 60 * 24 * (365/12)) {
refactored
Xavier Caron authored on 2013-08-30
1579
    $age_str = $self->_age_ago(month => int $age/60/60/24/(365/12));
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1580
  } elsif ($age >= 60 * 60 * 24 * 7) {
refactored
Xavier Caron authored on 2013-08-30
1581
    $age_str = $self->_age_ago(week => int $age/60/60/24/7);
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1582
  } elsif ($age >= 60 * 60 * 24) {
refactored
Xavier Caron authored on 2013-08-30
1583
    $age_str = $self->_age_ago(day => int $age/60/60/24);
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1584
  } elsif ($age >= 60 * 60) {
refactored
Xavier Caron authored on 2013-08-30
1585
    $age_str = $self->_age_ago(hour => int $age/60/60);
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1586
  } elsif ($age >= 60) {
refactored
Xavier Caron authored on 2013-08-30
1587
    $age_str = $self->_age_ago(min => int $age/60);
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1588
  } elsif ($age >= 1) {
refactored
Xavier Caron authored on 2013-08-30
1589
    $age_str = $self->_age_ago(sec => int $age);
copy gitweblite soruce code
root authored on 2012-11-23
1590
  } else {
fixed a typo
Xavier Caron authored on 2013-08-30
1591
    $age_str .= 'right now';
copy gitweblite soruce code
root authored on 2012-11-23
1592
  }
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
1593
  
1594
  $age_str =~ s/^1 /a /;
more phonetically correct
Xavier Caron authored on 2013-08-30
1595
  $age_str =~ s/^a hour/an hour/;
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
1596
  
copy gitweblite soruce code
root authored on 2012-11-23
1597
  return $age_str;
1598
}
1599

            
1600
sub _chop_str {
1601
  my $self = shift;
1602
  my $str = shift;
1603
  my $len = shift;
1604
  my $add_len = shift || 10;
1605
  my $where = shift || 'right';
1606

            
1607
  if ($where eq 'center') {
1608
    # Filler is length 5
1609
    return $str if ($len + 5 >= length($str));
1610
    $len = int($len/2);
1611
  } else {
1612
    # Filler is length 4
1613
    return $str if ($len + 4 >= length($str)); 
1614
  }
1615

            
1616
  # Regexps: ending and beginning with word part up to $add_len
1617
  my $endre = qr/.{$len}\w{0,$add_len}/;
1618
  my $begre = qr/\w{0,$add_len}.{$len}/;
1619

            
1620
  if ($where eq 'left') {
1621
    $str =~ m/^(.*?)($begre)$/;
1622
    my ($lead, $body) = ($1, $2);
1623
    if (length($lead) > 4) {
1624
      $lead = ' ...';
1625
    }
1626
    return "$lead$body";
1627

            
1628
  } elsif ($where eq 'center') {
1629
    $str =~ m/^($endre)(.*)$/;
1630
    my ($left, $str)  = ($1, $2);
1631
    $str =~ m/^(.*?)($begre)$/;
1632
    my ($mid, $right) = ($1, $2);
1633
    if (length($mid) > 5) {
1634
      $mid = ' ... ';
1635
    }
1636
    return "$left$mid$right";
1637

            
1638
  } else {
1639
    $str =~ m/^($endre)(.*)$/;
1640
    my $body = $1;
1641
    my $tail = $2;
1642
    if (length($tail) > 4) {
1643
      $tail = '... ';
1644
    }
1645
    return "$body$tail";
1646
  }
1647
}
1648

            
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1649
sub decide_encoding {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1650
  my ($self, $rep_info, $lines) = @_;
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1651
  
1652
  my $guess_encoding_str = $self->app->dbi->model('project')->select(
1653
    'guess_encoding',
cleanup methods
Yuki Kimoto authored on 2016-04-16
1654
    where => {user_id => $rep_info->{user}, name => $rep_info->{project}}
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1655
  )->value;
cleanup encoding_suspects
Yuki Kimoto authored on 2016-04-05
1656
  
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1657
  my @guess_encodings;
cleanup blame
Yuki Kimoto authored on 2016-04-16
1658
  if (defined $guess_encoding_str && length $guess_encoding_str) {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1659
    @guess_encodings = split(/\s*,\s*/, $guess_encoding_str);
1660
  }
cleanup encoding_suspects
Yuki Kimoto authored on 2016-04-05
1661
  
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1662
  my $encoding;
1663
  if (@guess_encodings) {
1664
    my @new_lines;
1665
    for (my $i = 0; $i < 100; $i++) {
1666
      last unless defined $lines->[$i];
1667
      push @new_lines, $lines->[$i];
1668
    }
1669
    
1670
    my $str = join('', @new_lines);
1671

            
1672
    my $ret = Encode::Guess->guess($str, @guess_encodings);
1673
    
improve dec_guess logic
Yuki Kimoto authored on 2016-04-05
1674
    if (ref $ret) {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1675
      $encoding = $ret->name;
improve dec_guess logic
Yuki Kimoto authored on 2016-04-05
1676
    }
1677
    else {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1678
      $encoding = $self->default_encoding
cleanup encoding_suspects
Yuki Kimoto authored on 2016-04-05
1679
    }
1680
  }
1681
  else {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1682
    $encoding = $self->default_encoding;
cleanup encoding_suspects
Yuki Kimoto authored on 2016-04-05
1683
  }
1684
  
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1685
  return $encoding;
Supported specific character...
Tetsuya Hayashi authored on 2014-03-15
1686
}
1687

            
cleanuP
Yuki Kimoto authored on 2016-04-16
1688
sub _age_string_date {
1689
  my ($self, $age) = @_;
1690

            
1691
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age);
1692
  my $age_string_date = sprintf '%4d-%02d-%02d', 1900 + $year, $mon + 1, $mday;
1693
  
1694
  return $age_string_date;
1695
}
1696

            
1697
sub _age_string_date_local {
1698
  my ($self, $age) = @_;
1699
  
1700
  my $time_zone_second = $self->time_zone_second || 0;
1701
  
1702
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age + $time_zone_second);
1703
  my $age_string_date_local = sprintf '%4d-%02d-%02d', 1900 + $year, $mon + 1, $mday;
1704
  
1705
  return $age_string_date_local;
1706
}
1707

            
cleanup
Yuki Kimoto authored on 2013-05-14
1708
sub _dec {
revert encoding support
Yuki Kimoto authored on 2013-11-22
1709
  my ($self, $str) = @_;
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1710
  
Renamed encoding to default_...
Tetsuya Hayashi authored on 2014-03-15
1711
  my $enc = $self->default_encoding;
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1712
  
cleanup encoding logic
Yuki Kimoto authored on 2016-04-05
1713
  $str = decode($enc, $str);
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1714
  
cleanup encoding logic
Yuki Kimoto authored on 2016-04-05
1715
  return $str;
added README commited rep fe...
Yuki Kimoto authored on 2013-03-28
1716
}
1717

            
revert encoding support
Yuki Kimoto authored on 2013-11-22
1718
sub _enc {
1719
  my ($self, $str) = @_;
1720
  
Renamed encoding to default_...
Tetsuya Hayashi authored on 2014-03-15
1721
  my $enc = $self->default_encoding;
revert encoding support
Yuki Kimoto authored on 2013-11-22
1722
  
1723
  return encode($enc, $str);
1724
}
1725

            
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1726
sub _mode_str {
1727
  my $self = shift;
1728
  my $mode = oct shift;
1729

            
1730
  # Mode to string
1731
  if ($self->_s_isgitlink($mode)) { return 'm---------' }
1732
  elsif (S_ISDIR($mode & S_IFMT)) { return 'drwxr-xr-x' }
1733
  elsif (S_ISLNK($mode)) { return 'lrwxrwxrwx' }
1734
  elsif (S_ISREG($mode)) {
1735
    if ($mode & S_IXUSR) {
1736
      return '-rwxr-xr-x';
1737
    } else {
1738
      return '-rw-r--r--'
1739
    }
1740
  } else { return '----------' }
1741
  
1742
  return;
1743
}
1744

            
1745
sub _s_isgitlink {
1746
  my ($self, $mode) = @_;
1747
  
1748
  # Check if git link
1749
  my $s_ifgitlink = 0160000;
1750
  return (($mode & S_IFMT) == $s_ifgitlink)
copy gitweblite soruce code
root authored on 2012-11-23
1751
}
1752

            
1753
sub _slurp {
1754
  my ($self, $file) = @_;
1755
  
1756
  # Slurp
1757
  open my $fh, '<', $file
1758
    or croak qq/Can't open file "$file": $!/;
cleanup
Yuki Kimoto authored on 2013-11-16
1759
  my $content = do { local $/; scalar <$fh> };
copy gitweblite soruce code
root authored on 2012-11-23
1760
  close $fh;
1761
  
1762
  return $content;
1763
}
1764

            
1765
sub _unquote {
1766
  my ($self, $str) = @_;
1767
  
1768
  # Unquote function
1769
  my $unq = sub {
1770
    my $seq = shift;
1771
    my %escapes = (
1772
      t => "\t",
1773
      n => "\n",
1774
      r => "\r",
1775
      f => "\f",
1776
      b => "\b",
1777
      a => "\a",
1778
      e => "\e",
1779
      v => "\013",
1780
    );
1781

            
1782
    if ($seq =~ m/^[0-7]{1,3}$/) { return chr oct $seq }
1783
    elsif (exists $escapes{$seq}) { return $escapes{$seq} }
1784
    
1785
    return $seq;
1786
  };
1787
  
1788
  # Unquote
1789
  if ($str =~ m/^"(.*)"$/) {
1790
    $str = $1;
1791
    $str =~ s/\\([^0-7]|[0-7]{1,3})/$unq->($1)/eg;
1792
  }
1793
  
1794
  return $str;
1795
}
1796

            
1797
1;