Newer Older
1775 lines | 41.685kb
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

            
cleanup compare logic
Yuki Kimoto authored on 2016-04-18
22
sub current_branch {
23
  my ($self, $rep_info) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
24
  
cleanup compare logic
Yuki Kimoto authored on 2016-04-18
25
  my @cmd = $self->cmd($rep_info, 'rev-parse',  '--abbrev-ref', 'HEAD');
cleanup branch_status
Yuki Kimoto authored on 2016-04-16
26
  
27
  open my $fh, '-|', @cmd
28
    or croak "Can't get current branch: @cmd";
29
  my $current_branch = <$fh>;
30
  chomp $current_branch;
31
  
32
  return $current_branch;
cleanup
Yuki Kimoto authored on 2013-05-14
33
}
34

            
cleanup compare logic
Yuki Kimoto authored on 2016-04-18
35
sub branch_names {
36
  my ($self, $rep_info) = @_;
37
  
38
  # Branch names
39
  my @cmd = $self->cmd($rep_info, 'branch');
40
  open my $fh, '-|', @cmd or return;
41
  
42
  my @lines = <$fh>;
43
  my @branch_names;
44
  for my $branch_name (@lines) {
45
    chomp $branch_name;
46
    $branch_name =~ s/^\*//;
47
    $branch_name =~ s/^\s*//;
48
    $branch_name =~ s/\s*$//;
49
    
50
    push @branch_names, $branch_name;
51
  }
52
  
53
  return \@branch_names;
54
}
55

            
cleanup branch_status
Yuki Kimoto authored on 2016-04-16
56
sub branch {
cleanup
Yuki Kimoto authored on 2016-04-16
57
  my ($self, $rep_info, $branch_name) = @_;
cleanup branch
Yuki Kimoto authored on 2016-04-16
58
  
59
  # Branch
60
  $branch_name =~ s/^\*//;
61
  $branch_name =~ s/^\s*//;
62
  $branch_name =~ s/\s*$//;
63
  my $branch = {};
64
  $branch->{name} = $branch_name;
cleanup methods
Yuki Kimoto authored on 2016-04-16
65
  my $commit = $self->get_commit($rep_info, $branch_name);
cleanup branch
Yuki Kimoto authored on 2016-04-16
66
  $branch->{commit} = $commit;
67

            
68
  return $branch;
69
}
70

            
cleanup
Yuki Kimoto authored on 2013-05-14
71
sub branch_status {
cleanup
Yuki Kimoto authored on 2016-04-16
72
  my ($self, $rep_info, $branch1, $branch2) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
73
  
74
  # Branch status
75
  my $status = {ahead => 0, behind => 0};
cleanup cmd
Yuki Kimoto authored on 2016-04-16
76
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
77
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
78
    'rev-list',
79
    '--left-right',
80
    "$branch1...$branch2"
cleanup
Yuki Kimoto authored on 2013-05-14
81
  );
82
  open my $fh, '-|', @cmd
83
    or croak "Can't get branch status: @cmd";
84
  while (my $line = <$fh>) {
85
    if ($line =~ /^</) { $status->{behind}++ }
86
    elsif ($line =~ /^>/) { $status->{ahead}++ }
87
  }
88
  
89
  return $status;
90
}
91

            
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
92
sub no_merged_branch_h {
cleanup
Yuki Kimoto authored on 2016-04-16
93
  my ($self, $rep_info) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
94
  
95
  # No merged branches
96
  my $no_merged_branches_h = {};
97
  {
cleanup
Yuki Kimoto authored on 2016-04-16
98
    my @cmd = $self->cmd($rep_info, 'branch', '--no-merged');
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
99
    open my $fh, '-|', @cmd or return;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
100
    my @lines = <$fh>;
101
    for my $branch_name (@lines) {
102
      $branch_name = $self->_dec($branch_name);
cleanup
Yuki Kimoto authored on 2013-05-14
103
      $branch_name =~ s/^\*//;
104
      $branch_name =~ s/^\s*//;
105
      $branch_name =~ s/\s*$//;
106
      $no_merged_branches_h->{$branch_name} = 1;
107
    }
108
  }
109
  
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
110
  return $no_merged_branches_h;
111
}
112

            
113
sub branches {
cleanup
Yuki Kimoto authored on 2016-04-16
114
  my ($self, $rep_info) = @_;
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
115
  
cleanup
Yuki Kimoto authored on 2013-05-14
116
  # Branches
cleanup
Yuki Kimoto authored on 2016-04-16
117
  my @cmd = $self->cmd($rep_info, 'branch');
cleanup
Yuki Kimoto authored on 2013-05-14
118
  open my $fh, '-|', @cmd or return;
119
  my $branches = [];
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
120
  my $start;
121
  my $no_merged_branches_h;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
122
  my @lines = <$fh>;
123
  for my $branch_name (@lines) {
124
    $branch_name = $self->_dec($branch_name);
fix no merged branch not sho...
Yuki Kimoto authored on 2013-05-27
125
    $branch_name =~ s/^\*//;
126
    $branch_name =~ s/^\s*//;
127
    $branch_name =~ s/\s*$//;
cleanup
Yuki Kimoto authored on 2013-05-14
128
    
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
129
    # No merged branch
cleanup
Yuki Kimoto authored on 2016-04-16
130
    $no_merged_branches_h = $self->no_merged_branch_h($rep_info)
add rename project and suppr...
Yuki Kimoto authored on 2013-05-24
131
      unless $start++;
132
    
cleanup
Yuki Kimoto authored on 2013-05-14
133
    # Branch
cleanup
Yuki Kimoto authored on 2016-04-16
134
    my $branch = $self->branch($rep_info, $branch_name);
cleanup
Yuki Kimoto authored on 2013-05-14
135
    $branch->{no_merged} = 1 if $no_merged_branches_h->{$branch_name};
136
    push @$branches, $branch;
137
  }
138
  @$branches = sort { $a->{commit}{age} <=> $b->{commit}{age} } @$branches;
139
  
140
  return $branches;
141
}
142

            
143
sub branches_count {
cleanup
Yuki Kimoto authored on 2016-04-16
144
  my ($self, $rep_info) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
145
  
146
  # Branches count
cleanup
Yuki Kimoto authored on 2016-04-16
147
  my @cmd = $self->cmd($rep_info, 'branch');
cleanup
Yuki Kimoto authored on 2013-05-14
148
  open my $fh, '-|', @cmd or return;
149
  my @branches = <$fh>;
150
  my $branches_count = @branches;
151
  
152
  return $branches_count;
153
}
154

            
cleanup cmd
Yuki Kimoto authored on 2016-04-16
155
sub cmd {
cleanup
Yuki Kimoto authored on 2016-04-16
156
  my ($self, $rep_info, @command) = @_;
cleanup cmd
Yuki Kimoto authored on 2016-04-16
157
  
cleanup
Yuki Kimoto authored on 2016-04-16
158
  my $git_dir = $rep_info->{git_dir};
159
  my $work_tree = $rep_info->{work_tree};
cleanup cmd
Yuki Kimoto authored on 2016-04-16
160
  
161
  my @command_all = ($self->bin);
162
  if (defined $git_dir) {
163
    push @command_all, "--git-dir=$git_dir";
164
  }
165
  if (defined $work_tree) {
166
    push @command_all, "--work-tree=$work_tree";
167
  }
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
168
  push @command_all, @command;
cleanup cmd
Yuki Kimoto authored on 2016-04-16
169
  
170
  return @command_all;
171
}
172

            
added contributer count
Yuki Kimoto authored on 2013-01-28
173
sub authors {
cleanup
Yuki Kimoto authored on 2016-04-16
174
  my ($self, $rep_info, $rev, $file) = @_;
added contributer count
Yuki Kimoto authored on 2013-01-28
175
  
cleanup
Yuki Kimoto authored on 2013-05-14
176
  # Authors
cleanup authors
Yuki Kimoto authored on 2016-04-16
177
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
178
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
179
    'log',
180
    '--format=%an',
181
    $rev,
182
    '--',
183
    $file
cleanup blob page
Yuki Kimoto authored on 2013-03-19
184
  );
added contributer count
Yuki Kimoto authored on 2013-01-28
185
  open my $fh, "-|", @cmd
186
    or croak 500, "Open git-cat-file failed";
187
  my $authors = {};
cleanup encoding
Yuki Kimoto authored on 2016-04-05
188
  my @lines = <$fh>;
189
  for my $line (@lines) {
190
    $line = $self->_dec($line);
added contributer count
Yuki Kimoto authored on 2013-01-28
191
    $line =~ s/[\r\n]//g;
192
    $authors->{$line} = 1;
193
  }
194
  
195
  return [sort keys %$authors];
196
}
197

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

            
274
sub blob {
cleanup
Yuki Kimoto authored on 2016-04-16
275
  my ($self, $rep_info, $rev, $file) = @_;
add blame method
Yuki Kimoto authored on 2013-08-10
276
  
277
  # Blob
cleanup method
Yuki Kimoto authored on 2016-04-16
278
  my $hash = $self->path_to_hash($rep_info, $rev, $file, 'blob')
add blame method
Yuki Kimoto authored on 2013-08-10
279
    or croak 'Cannot find file';
cleanup blob
Yuki Kimoto authored on 2016-04-16
280
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
281
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
282
    'cat-file',
283
    'blob',
284
    $hash
add blame method
Yuki Kimoto authored on 2013-08-10
285
  );
286
  open my $fh, '-|', @cmd
287
    or croak "Can't cat $file, $hash";
288
  
289
  # Format lines
cleanup encoding
Yuki Kimoto authored on 2016-04-05
290
  my @lines = <$fh>;
291
  my @new_lines;
cleanup methods
Yuki Kimoto authored on 2016-04-16
292
  my $enc = $self->decide_encoding($rep_info, \@lines);
cleanup encoding
Yuki Kimoto authored on 2016-04-05
293
  for my $line (@lines) {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
294
    $line = decode($enc, $line);
add blame method
Yuki Kimoto authored on 2013-08-10
295
    chomp $line;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
296
    push @new_lines, $line;
add blame method
Yuki Kimoto authored on 2013-08-10
297
  }
298
  
cleanup encoding
Yuki Kimoto authored on 2016-04-05
299
  return \@new_lines;
add blame method
Yuki Kimoto authored on 2013-08-10
300
}
301

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

            
binary data not shown
Yuki Kimoto authored on 2013-06-02
396
sub blob_is_image {
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
397
  my $self = shift;
binary data not shown
Yuki Kimoto authored on 2013-06-02
398
  
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
399
  my $mime_type = $self->blob_mime_type(@_);
binary data not shown
Yuki Kimoto authored on 2013-06-02
400
  
401
  return ($mime_type || '') =~ m#^image/#;
402
}
403

            
cleanup
Yuki Kimoto authored on 2013-05-14
404
sub blob_mime_type {
cleanup
Yuki Kimoto authored on 2016-04-16
405
  my ($self, $rep_info, $rev, $file) = @_;
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
406
  
cleanup
Yuki Kimoto authored on 2013-05-14
407
  # Blob
cleanup method
Yuki Kimoto authored on 2016-04-16
408
  my $hash = $self->path_to_hash($rep_info, $rev, $file, 'blob')
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
409
    or croak 'Cannot find file';
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
410
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
411
    $rep_info,
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
412
    'cat-file',
413
    'blob',
cleanup
Yuki Kimoto authored on 2013-05-14
414
    $hash
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
415
  );
416
  open my $fh, '-|', @cmd
cleanup
Yuki Kimoto authored on 2013-05-14
417
    or croak "Can't cat $file, $hash";
copy gitweblite soruce code
root authored on 2012-11-23
418

            
419
  return 'text/plain' unless $fh;
420
  
421
  # MIME type
422
  my $text_exts = $self->text_exts;
423
  for my $text_ext (@$text_exts) {
424
    my $ext = quotemeta($text_ext);
425
    return 'text/plain' if $file =~ /\.$ext$/i;
426
  }
427
  if (-T $fh) { return 'text/plain' }
428
  elsif (! $file) { return 'application/octet-stream' }
429
  elsif ($file =~ m/\.png$/i) { return 'image/png' }
430
  elsif ($file =~ m/\.gif$/i) { return 'image/gif' }
431
  elsif ($file =~ m/\.jpe?g$/i) { return 'image/jpeg'}
432
  else { return 'application/octet-stream'}
433
  
434
  return;
435
}
436

            
cleanup
Yuki Kimoto authored on 2013-05-14
437
sub blob_content_type {
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
438
  my $self = shift;
copy gitweblite soruce code
root authored on 2012-11-23
439
  
440
  # Content type
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
441
  my $type = $self->blob_mime_type(@_);
copy gitweblite soruce code
root authored on 2012-11-23
442
  if ($type eq 'text/plain') {
Renamed encoding to default_...
Tetsuya Hayashi authored on 2014-03-15
443
    $type .= "; charset=" . $self->default_encoding;
copy gitweblite soruce code
root authored on 2012-11-23
444
  }
445

            
446
  return $type;
447
}
448

            
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
449
sub blob_mode {
cleanup
Yuki Kimoto authored on 2016-04-16
450
  my ($self, $rep_info, $rev, $file) = @_;
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
451
  
cleanup
Yuki Kimoto authored on 2013-05-14
452
  # Blob mode
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
453
  $file =~ s#/+$##;
cleanup blob_mode
Yuki Kimoto authored on 2016-04-16
454
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
455
    $rep_info,
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
456
    'ls-tree',
457
    $rev,
458
    '--',
459
    $file
460
  );
461
  open my $fh, '-|', @cmd
462
    or croak 'Open git-ls-tree failed';
cleanup encoding
Yuki Kimoto authored on 2016-04-05
463
  my $line = <$fh>;
464
  $line = $self->_dec($line);
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
465
  close $fh or return;
466
  my ($mode) = ($line || '') =~ m/^([0-9]+) /;
467
  
468
  return $mode;
469
}
470

            
471
sub blob_raw {
cleanup
Yuki Kimoto authored on 2016-04-16
472
  my ($self, $rep_info, $rev, $path) = @_;
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
473
  
cleanup
Yuki Kimoto authored on 2013-05-14
474
  # Blob raw
cleanup
Yuki Kimoto authored on 2016-04-16
475
  my @cmd = $self->cmd($rep_info, 'cat-file', 'blob', "$rev:$path");
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
476
  open my $fh, "-|", @cmd
477
    or croak 500, "Open git-cat-file failed";
478
  local $/;
cleanup blob_raw
Yuki Kimoto authored on 2016-04-16
479
  my $blob_raw = <$fh>;
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
480

            
481
  close $fh or croak 'Reading git-shortlog failed';
482
  
483
  return $blob_raw;
484
}
485

            
cleanup
Yuki Kimoto authored on 2013-05-14
486
sub blob_size {
cleanup
Yuki Kimoto authored on 2016-04-16
487
  my ($self, $rep_info, $rev, $file) = @_;
added file size to blob page
Yuki Kimoto authored on 2013-01-29
488
  
cleanup
Yuki Kimoto authored on 2013-05-14
489
  # Blob size(KB)
cleanup blob_size
Yuki Kimoto authored on 2016-04-16
490
  my @cmd = $self->cmd(
cleanup
Yuki Kimoto authored on 2016-04-16
491
    $rep_info,
cleanup blob page
Yuki Kimoto authored on 2013-03-19
492
    'cat-file',
493
    '-s',
494
    "$rev:$file"
495
  );
added file size to blob page
Yuki Kimoto authored on 2013-01-29
496
  open my $fh, "-|", @cmd
497
    or croak 500, "Open cat-file failed";
cleanup encoding
Yuki Kimoto authored on 2016-04-05
498
  my $size = <$fh>;
499
  $size = $self->_dec($size);
added file size to blob page
Yuki Kimoto authored on 2013-01-29
500
  chomp $size;
501
  close $fh or croak 'Reading cat-file failed';
502
  
cleanup
Yuki Kimoto authored on 2013-05-14
503
  # Format
504
  my $size_f = sprintf('%.3f', $size / 1000);
505
  $size_f =~ s/0+$//;
improved blob page desing
Yuki Kimoto authored on 2013-05-02
506
  
cleanup
Yuki Kimoto authored on 2013-05-14
507
  return $size_f;
added file size to blob page
Yuki Kimoto authored on 2013-01-29
508
}
509

            
improved create repository f...
Yuki Kimoto authored on 2013-03-21
510
sub check_head_link {
511
  my ($self, $dir) = @_;
added separeted commit getti...
Yuki Kimoto authored on 2013-02-04
512
  
improved create repository f...
Yuki Kimoto authored on 2013-03-21
513
  # Chack head
514
  my $head_file = "$dir/HEAD";
515
  return ((-e $head_file) ||
516
    (-l $head_file && readlink($head_file) =~ /^refs\/heads\//));
517
}
added separeted commit getti...
Yuki Kimoto authored on 2013-02-04
518

            
added commits number
Yuki Kimoto authored on 2012-11-28
519
sub commits_number {
cleanup
Yuki Kimoto authored on 2016-04-16
520
  my ($self, $rep_info, $ref) = @_;
added commits number
Yuki Kimoto authored on 2012-11-28
521
  
522
  # Command "git diff-tree"
cleanup
Yuki Kimoto authored on 2016-04-16
523
  my @cmd = $self->cmd($rep_info, 'shortlog', '-s', $ref);
added commits number
Yuki Kimoto authored on 2012-11-28
524
  open my $fh, "-|", @cmd
525
    or croak 500, "Open git-shortlog failed";
cleanup encoding
Yuki Kimoto authored on 2016-04-05
526
  my @commits_infos = <$fh>;
527
  @commits_infos = map { chomp; $self->_dec($_) } @commits_infos;
added commits number
Yuki Kimoto authored on 2012-11-28
528
  close $fh or croak 'Reading git-shortlog failed';
529
  
530
  my $commits_num = 0;
531
  for my $commits_info (@commits_infos) {
532
    if ($commits_info =~ /^ *([0-9]+)/) {
533
      $commits_num += $1;
534
    }
535
  }
536
  
537
  return $commits_num;
538
}
539

            
cleanup
Yuki Kimoto authored on 2013-05-14
540
sub exists_branch {
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
541
  my ($self, $rep) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
542
  
543
  # Exists branch
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
544
  my @cmd = $self->cmd($rep, 'branch');
cleanup
Yuki Kimoto authored on 2013-05-14
545
  open my $fh, "-|", @cmd
546
    or croak 'git branch failed';
547
  local $/;
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
548
  my $branch = <$fh>;
cleanup
Yuki Kimoto authored on 2013-05-14
549
  
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
550
  return $branch ne '' ? 1 : 0;
cleanup
Yuki Kimoto authored on 2013-05-14
551
}
552

            
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
553
sub delete_branch {
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
554
  my ($self, $rep, $branch) = @_;
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
555
  
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
556
  my $branches = $self->branches($rep);
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
557
  my $exists;
558
  for my $b (@$branches) {
559
    if ($branch eq $b->{name}) {
560
      $exists = 1;
561
      next;
562
    }
563
  }
564
  
565
  if ($exists) {
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
566
    my @cmd = $self->cmd($rep, 'branch', '-D', $branch);
fix bug that in CGI reposito...
Yuki Kimoto authored on 2015-11-05
567
    Gitprep::Util::run_command(@cmd)
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
568
      or croak "Branch deleting failed. Can't delete branch $branch";
569
  }
570
  else {
571
    croak "Branch deleteting failed.. branchg $branch is not exists";
572
  }
573
}
574

            
added project rename feature
Yuki Kimoto authored on 2013-03-25
575
sub description {
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
576
  my ($self, $rep, $description) = @_;
added project rename feature
Yuki Kimoto authored on 2013-03-25
577
  
cleanup descriptioN
Yuki Kimoto authored on 2016-04-16
578
  my $git_dir = $rep->{git_dir};
579
  my $file = "$git_dir/description";
added project rename feature
Yuki Kimoto authored on 2013-03-25
580
  
581
  if (defined $description) {
582
    # Write description
583
    open my $fh, '>',$file
584
      or croak "Can't open file $rep: $!";
585
    print $fh encode('UTF-8', $description)
586
      or croak "Can't write description: $!";
587
    close $fh;
588
  }
589
  else {
590
    # Read description
added not exists repository ...
Yuki Kimoto authored on 2013-05-15
591
    return unless -f $file;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
592
    my $description = $self->_slurp($file) || '';
593
    $description = $self->_dec($description);
added project rename feature
Yuki Kimoto authored on 2013-03-25
594
    return $description;
595
  }
596
}
597

            
cleanup
Yuki Kimoto authored on 2013-05-14
598
sub diff_tree {
cleanup method
Yuki Kimoto authored on 2016-04-16
599
  my ($self, $rep_info, $rev, $parent, $opt) = @_;
add --ignore-space-change fe...
Yuki Kimoto authored on 2014-12-09
600
  
601
  $opt ||= {};
602
  my $ignore_space_change = $opt->{ignore_space_change};
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
603
  
copy gitweblite soruce code
root authored on 2012-11-23
604
  # Root
605
  $parent = '--root' unless defined $parent;
606

            
cleanup
Yuki Kimoto authored on 2013-03-19
607
  # Get diff tree
cleanup method
Yuki Kimoto authored on 2016-04-16
608
  my @cmd = $self->cmd(
609
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
610
    "diff-tree",
611
    '-r',
612
    '--no-commit-id',
613
    '-M',
add --ignore-space-change fe...
Yuki Kimoto authored on 2014-12-09
614
    ($ignore_space_change ? '--ignore-space-change' : ()),
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
615
    $parent,
616
    $rev,
cleanup
Yuki Kimoto authored on 2013-03-19
617
    '--'
618
  );
add --ignore-space-change fe...
Yuki Kimoto authored on 2014-12-09
619
  
copy gitweblite soruce code
root authored on 2012-11-23
620
  open my $fh, "-|", @cmd
621
    or croak 500, "Open git-diff-tree failed";
cleanup encoding
Yuki Kimoto authored on 2016-04-05
622
  my @diff_tree = <$fh>;
623
  @diff_tree = map { chomp; $self->_dec($_) } @diff_tree;
copy gitweblite soruce code
root authored on 2012-11-23
624
  close $fh or croak 'Reading git-diff-tree failed';
625
  
626
  # Parse "git diff-tree" output
627
  my $diffs = [];
cleanup
Yuki Kimoto authored on 2013-05-14
628
  for my $line (@diff_tree) {
629
    my $diff = $self->parsed_diff_tree_line($line);
copy gitweblite soruce code
root authored on 2012-11-23
630
    
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
631
    my ($to_mode_oct, $to_mode_str, $to_file_type);
632
    my ($from_mode_oct, $from_mode_str, $from_file_type);
633
    if ($diff->{to_mode} ne ('0' x 6)) {
634
      $to_mode_oct = oct $diff->{to_mode};
635
      if (S_ISREG($to_mode_oct)) { # only for regular file
636
        $to_mode_str = sprintf('%04o', $to_mode_oct & 0777); # permission bits
copy gitweblite soruce code
root authored on 2012-11-23
637
      }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
638
      $to_file_type = $self->file_type($diff->{to_mode});
639
    }
640
    if ($diff->{from_mode} ne ('0' x 6)) {
641
      $from_mode_oct = oct $diff->{from_mode};
642
      if (S_ISREG($from_mode_oct)) { # only for regular file
643
        $from_mode_str = sprintf('%04o', $from_mode_oct & 0777); # permission bits
copy gitweblite soruce code
root authored on 2012-11-23
644
      }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
645
      $from_file_type = $self->file_type($diff->{from_mode});
copy gitweblite soruce code
root authored on 2012-11-23
646
    }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
647
    
648
    $diff->{to_mode_str} = $to_mode_str;
649
    $diff->{to_mode_oct} = $to_mode_oct;
650
    $diff->{to_file_type} = $to_file_type;
651
    $diff->{from_mode_str} = $from_mode_str;
652
    $diff->{from_mode_oct} = $from_mode_oct;
653
    $diff->{from_file_type} = $from_file_type;
654

            
655
    push @$diffs, $diff;
copy gitweblite soruce code
root authored on 2012-11-23
656
  }
657
  
658
  return $diffs;
659
}
660

            
added branch deleting featur...
Yuki Kimoto authored on 2013-05-05
661
sub file_type {
662
  my ($self, $mode) = @_;
663
  
664
  # File type
665
  if ($mode !~ m/^[0-7]+$/) { return $mode }
666
  else { $mode = oct $mode }
667
  if ($self->_s_isgitlink($mode)) { return 'submodule' }
668
  elsif (S_ISDIR($mode & S_IFMT)) { return 'directory' }
669
  elsif (S_ISLNK($mode)) { return 'symlink' }
670
  elsif (S_ISREG($mode)) { return 'file' }
671
  else { return 'unknown' }
672
  
673
  return
674
}
675

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

            
cleanup
Yuki Kimoto authored on 2013-05-14
694
sub forward_commits {
cleanup method
Yuki Kimoto authored on 2016-04-16
695
  my ($self, $rep_info, $rev1, $rev2) = @_;
setting page
Yuki Kimoto authored on 2013-03-24
696
  
cleanup
Yuki Kimoto authored on 2013-05-14
697
  # Forwarding commits
cleanup method
Yuki Kimoto authored on 2016-04-16
698
  my @cmd = $self->cmd(
699
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-05-14
700
    'rev-list',
701
    '--left-right',
702
    "$rev1...$rev2"
703
  );
704
  open my $fh, '-|', @cmd
705
    or croak "Can't get info: @cmd";
706
  my $commits = [];
707
  while (my $line = <$fh>) {
708
    if ($line =~ /^>(.+)\s/) {
709
      my $rev = $1;
cleanup methods
Yuki Kimoto authored on 2016-04-16
710
      my $commit = $self->get_commit($rep_info, $rev);
cleanup
Yuki Kimoto authored on 2013-05-14
711
      push @$commits, $commit;
added merged branches to bra...
Yuki Kimoto authored on 2013-05-03
712
    }
713
  }
714
  
cleanup
Yuki Kimoto authored on 2013-05-14
715
  return $commits;
added merged branches to bra...
Yuki Kimoto authored on 2013-05-03
716
}
717

            
cleanup
Yuki Kimoto authored on 2013-05-14
718
sub path_to_hash {
cleanup method
Yuki Kimoto authored on 2016-04-16
719
  my ($self, $rep_info, $rev, $path, $type) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
720
  
721
  # Get blob id or tree id (command "git ls-tree")
722
  $path =~ s#/+$##;
cleanup method
Yuki Kimoto authored on 2016-04-16
723
  my @cmd = $self->cmd(
724
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
725
    'ls-tree',
cleanup
Yuki Kimoto authored on 2013-04-29
726
    $rev,
cleanup
Yuki Kimoto authored on 2013-03-19
727
    '--',
728
    $path
729
  );
copy gitweblite soruce code
root authored on 2012-11-23
730
  open my $fh, '-|', @cmd
731
    or croak 'Open git-ls-tree failed';
cleanup encoding
Yuki Kimoto authored on 2016-04-05
732
  my $line = <$fh>;
733
  $line = $self->_dec($line);
copy gitweblite soruce code
root authored on 2012-11-23
734
  close $fh or return;
735
  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
736
  $t ||= '';
copy gitweblite soruce code
root authored on 2012-11-23
737
  return if defined $type && $type ne $t;
738

            
739
  return $id;
740
}
741

            
cleanup
Yuki Kimoto authored on 2013-05-14
742

            
743
sub last_activity {
cleanup method
Yuki Kimoto authored on 2016-04-16
744
  my ($self, $rep) = @_;
added branch and tag refs to...
Yuki Kimoto authored on 2013-04-26
745
  
cleanup
Yuki Kimoto authored on 2013-05-14
746
  # Command "git for-each-ref"
cleanup method
Yuki Kimoto authored on 2016-04-16
747
  my @cmd = $self->cmd(
748
    $rep,
cleanup
Yuki Kimoto authored on 2013-05-14
749
    'for-each-ref',
750
    '--format=%(committer)',
751
    '--sort=-committerdate',
752
    '--count=1', 'refs/heads'
added branch and tag refs to...
Yuki Kimoto authored on 2013-04-26
753
  );
cleanup
Yuki Kimoto authored on 2013-05-14
754
  open my $fh, '-|', @cmd or return;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
755
  my $most_recent = <$fh>;
756
  $most_recent = $self->_dec($most_recent);
cleanup
Yuki Kimoto authored on 2013-05-14
757
  close $fh or return;
added branch and tag refs to...
Yuki Kimoto authored on 2013-04-26
758
  
cleanup
Yuki Kimoto authored on 2013-05-14
759
  # Parse most recent
760
  if (defined $most_recent &&
761
      $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
762
    my $timestamp = $1;
763
    my $age = time - $timestamp;
764
    return ($age, $self->_age_string($age));
added branch and tag refs to...
Yuki Kimoto authored on 2013-04-26
765
  }
766
  
cleanup
Yuki Kimoto authored on 2013-05-14
767
  return;
768
}
769

            
770
sub parse_rev_path {
cleanup tags
Yuki Kimoto authored on 2016-04-16
771
  my ($self, $rep_info, $rev_path) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
772
  
cleanup
Yuki Kimoto authored on 2013-05-14
773
  # References
cleanup parse_rev_path
Yuki Kimoto authored on 2016-04-16
774
  my @cmd = $self->cmd(
cleanup tags
Yuki Kimoto authored on 2016-04-16
775
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-05-14
776
    'show-ref',
777
    '--dereference'
cleanup
Yuki Kimoto authored on 2013-03-19
778
  );
cleanup
Yuki Kimoto authored on 2013-05-14
779
  open my $fh, '-|', @cmd
780
    or return;
781
  my $refs = [];
cleanup encoding
Yuki Kimoto authored on 2016-04-05
782
  my @lines = <$fh>;
783
  for my $line (@lines) {
784
    $line = $self->_dec($line);
cleanup
Yuki Kimoto authored on 2013-05-14
785
    chomp $line;
786
    if ($line =~ m!^[0-9a-fA-F]{40}\s(refs/((?:heads|tags)/(.*)))$!) {
787
      push @$refs, $1, $2, $3;
788
    }
789
  }
copy gitweblite soruce code
root authored on 2012-11-23
790
  close $fh or return;
791
  
cleanup
Yuki Kimoto authored on 2013-05-14
792
  @$refs = sort {
793
    my @a_match = $a =~ /(\/)/g;
794
    my @b_match = $b =~ /(\/)/g;
795
    scalar @b_match <=> scalar @a_match;
796
  } @$refs;
797
  
798
  for my $ref (@$refs) {
799
    $rev_path =~ m#/$#;
800
    if ($rev_path =~ m#^(\Q$ref\E)/(.+)#) {
801
      my $rev = $1;
802
      my $path = $2;
803
      return ($rev, $path);
804
    }
805
    elsif ($rev_path eq $ref) {
806
      return ($rev_path, '');
807
    }
copy gitweblite soruce code
root authored on 2012-11-23
808
  }
809
  
cleanup
Yuki Kimoto authored on 2013-05-14
810
  if ($rev_path) {
811
    my ($rev, $path) = split /\//, $rev_path, 2;
812
    $path = '' unless defined $path;
813
    return ($rev, $path);
814
  }
815

            
copy gitweblite soruce code
root authored on 2012-11-23
816
  return;
817
}
818

            
819
sub object_type {
cleanup tags
Yuki Kimoto authored on 2016-04-16
820
  my ($self, $rep_info, $rev) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
821
  
cleanup
Yuki Kimoto authored on 2013-03-19
822
  # Get object type
cleanup tags
Yuki Kimoto authored on 2016-04-16
823
  my @cmd = $self->cmd(
824
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
825
    'cat-file',
826
    '-t',
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
827
    $rev
cleanup
Yuki Kimoto authored on 2013-03-19
828
  );
copy gitweblite soruce code
root authored on 2012-11-23
829
  open my $fh, '-|', @cmd  or return;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
830
  my $type = <$fh>;
831
  $type = $self->_dec($type);
copy gitweblite soruce code
root authored on 2012-11-23
832
  close $fh or return;
833
  chomp $type;
834
  
835
  return $type;
836
}
837

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

            
cleanup
Yuki Kimoto authored on 2016-04-16
841
  return unless -d $rep_info->{git_dir};
Fixed repositories page
Yuki Kimoto authored on 2012-11-23
842
  
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
843
  my $rep = {};
cleanup tags
Yuki Kimoto authored on 2016-04-16
844
  my @activity = $self->last_activity($rep_info);
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
845
  if (@activity) {
846
    $rep->{age} = $activity[0];
847
    $rep->{age_string} = $activity[1];
Fixed repositories page
Yuki Kimoto authored on 2012-11-23
848
  }
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
849
  else { $rep->{age} = 0 }
850
  
cleanup tags
Yuki Kimoto authored on 2016-04-16
851
  my $description = $self->description($rep_info) || '';
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
852
  $rep->{description} = $self->_chop_str($description, 25, 5);
cleanup
Yuki Kimoto authored on 2013-03-19
853
  
show deleted repository in u...
Yuki Kimoto authored on 2013-05-15
854
  return $rep;
Fixed repositories page
Yuki Kimoto authored on 2012-11-23
855
}
856

            
cleanup
Yuki Kimoto authored on 2013-05-14
857
sub references {
cleanup tags
Yuki Kimoto authored on 2016-04-16
858
  my ($self, $rep_info, $type) = @_;
cleanup
Yuki Kimoto authored on 2013-05-14
859
  
860
  $type ||= '';
861
  
862
  # Branches or tags
cleanup tags
Yuki Kimoto authored on 2016-04-16
863
  my @cmd = $self->cmd(
864
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-05-14
865
    'show-ref',
866
    '--dereference',
867
    (
868
      $type eq 'heads' ? ('--heads') :
869
      $type eq 'tags' ? ('--tags') :
870
      ()
871
    )
872
  );
873
  
874
  open my $fh, '-|', @cmd
875
    or return;
876
  
877
  # Parse references
878
  my %refs;
879
  my $type_re = $type ? $type : '(?:heads|tags)';
cleanup encoding
Yuki Kimoto authored on 2016-04-05
880
  my @lines = <$fh>;
881
  for my $line (@lines) {
882
    $line = $self->_dec($line);
cleanup
Yuki Kimoto authored on 2013-05-14
883
    chomp $line;
884
    if ($line =~ m!^([0-9a-fA-F]{40})\srefs/$type_re/(.*)$!) {
improved tag and branch refe...
Yuki Kimoto authored on 2013-06-03
885
      my $rev = $1;
886
      my $ref = $2;
887
      $ref =~ s/\^\{\}//;
888
      if (defined $refs{$rev}) { push @{$refs{$rev}}, $ref }
889
      else { $refs{$rev} = [$ref] }
cleanup
Yuki Kimoto authored on 2013-05-14
890
    }
891
  }
892
  close $fh or return;
893
  
894
  return \%refs;
895
}
896

            
copy gitweblite soruce code
root authored on 2012-11-23
897
sub short_id {
898
  my ($self, $project) = (shift, shift);
899
  
900
  # Short id
901
  return $self->id($project, @_, '--short=7');
902
}
903

            
improved tag page design
Yuki Kimoto authored on 2013-05-01
904
sub tags_count {
cleanup methods
Yuki Kimoto authored on 2016-04-16
905
  my ($self, $rep_info) = @_;
improved tag page design
Yuki Kimoto authored on 2013-05-01
906
  
907
  my $limit = 1000;
908
  
909
  # Get tags
cleanup methods
Yuki Kimoto authored on 2016-04-16
910
  my @cmd = $self->cmd(
911
    $rep_info,
improved tag page design
Yuki Kimoto authored on 2013-05-01
912
    'for-each-ref',
913
    ($limit ? '--count='.($limit+1) : ()),
914
    'refs/tags'
915
  );
916
  open my $fh, '-|', @cmd or return;
917
  
918
  # Tags count
919
  my @lines = <$fh>;
920
  
921
  return scalar @lines;
922
}
923

            
copy gitweblite soruce code
root authored on 2012-11-23
924
sub tags {
cleanup tags
Yuki Kimoto authored on 2016-04-16
925
  my ($self, $rep_info, $limit, $count, $offset) = @_;
improved tag page design
Yuki Kimoto authored on 2013-05-01
926
  
927
  $limit ||= 1000;
928
  $count ||= 50;
929
  $offset ||= 0;
cleanup
Yuki Kimoto authored on 2013-03-19
930
  
931
  # Get tags
cleanup tags
Yuki Kimoto authored on 2016-04-16
932
  my @cmd = $self->cmd(
933
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
934
    'for-each-ref',
935
    ($limit ? '--count='.($limit+1) : ()),
936
    '--sort=-creatordate',
937
    '--format=%(objectname) %(objecttype) %(refname) '
938
      . '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
939
    'refs/tags'
940
  );
copy gitweblite soruce code
root authored on 2012-11-23
941
  open my $fh, '-|', @cmd or return;
942
  
improved tag page design
Yuki Kimoto authored on 2013-05-01
943
  
copy gitweblite soruce code
root authored on 2012-11-23
944
  # Parse Tags
945
  my @tags;
improved tag page design
Yuki Kimoto authored on 2013-05-01
946
  my $line_num = 1;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
947
  my @lines = <$fh>;
948
  for my $line (@lines) {
949
    $line = $self->_dec($line);
copy gitweblite soruce code
root authored on 2012-11-23
950
    
improved tag page design
Yuki Kimoto authored on 2013-05-01
951
    if ($line_num > $offset && $line_num < $offset + $count + 1) {
952
    
953
      my %tag;
954

            
955
      chomp $line;
956
      my ($refinfo, $creatorinfo) = split(/\0/, $line);
957
      my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
958
      my ($creator, $epoch, $tz) =
959
        ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
960
      $tag{fullname} = $name;
961
      $name =~ s!^refs/tags/!!;
962

            
963
      $tag{type} = $type;
964
      $tag{id} = $id;
965
      $tag{name} = $name;
966
      if ($type eq 'tag') {
967
        $tag{subject} = $title;
968
        $tag{reftype} = $reftype;
969
        $tag{refid}   = $refid;
copy gitweblite soruce code
root authored on 2012-11-23
970
      } else {
improved tag page design
Yuki Kimoto authored on 2013-05-01
971
        $tag{reftype} = $type;
972
        $tag{refid}   = $id;
copy gitweblite soruce code
root authored on 2012-11-23
973
      }
974

            
improved tag page design
Yuki Kimoto authored on 2013-05-01
975
      if ($type eq 'tag' || $type eq 'commit') {
976
        $tag{epoch} = $epoch;
977
        if ($epoch) {
978
          $tag{age} = $self->_age_string(time - $tag{epoch});
979
        } else {
980
          $tag{age} = 'unknown';
981
        }
982
      }
983
      
984
      $tag{comment_short} = $self->_chop_str($tag{subject}, 30, 5)
985
        if $tag{subject};
986

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

            
989
      push @tags, \%tag;
990
    }
991
    $line_num++;
copy gitweblite soruce code
root authored on 2012-11-23
992
  }
improved tag page design
Yuki Kimoto authored on 2013-05-01
993
  
copy gitweblite soruce code
root authored on 2012-11-23
994
  close $fh;
995

            
996
  return \@tags;
997
}
998

            
improved project page design
Yuki Kimoto authored on 2013-04-29
999
sub last_change_commit {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1000
  my ($self, $rep_info, $rev, $file) = @_;
improved project page design
Yuki Kimoto authored on 2013-04-29
1001
  
1002
  my $commit_log = {};
1003
  $file = '' unless defined $file;
1004
  
cleanup methods
Yuki Kimoto authored on 2016-04-16
1005
  my @cmd = $self->cmd(
1006
    $rep_info,
improved project page design
Yuki Kimoto authored on 2013-04-29
1007
    '--no-pager',
1008
    'log',
1009
    '-n',
1010
    '1',
1011
    '--pretty=format:%H', 
1012
    $rev,
1013
    '--',
1014
    $file
1015
  );
1016
  open my $fh, '-|', @cmd
1017
    or croak 'Open git-log failed';
1018
  
1019
  local $/;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
1020
  my $commit_log_text = <$fh>;
1021
  $commit_log_text = $self->_dec($commit_log_text);
improved project page design
Yuki Kimoto authored on 2013-04-29
1022
  
1023
  my $commit;
1024
  if ($commit_log_text =~ /^([0-9a-zA-Z]+)/) {
1025
    my $rev = $1;
cleanup methods
Yuki Kimoto authored on 2016-04-16
1026
    $commit = $self->get_commit($rep_info, $rev);
improved project page design
Yuki Kimoto authored on 2013-04-29
1027
  }
1028
  
1029
  return $commit;
1030
}
1031

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

            
1035
  my $diff_info = {};
1036

            
added commit page
Yuki Kimoto authored on 2013-01-29
1037
  # Parse
1038
  my @lines;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1039
  my $next_before_line_num;
1040
  my $next_after_line_num;
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1041
  my $add_line_count = 0;
1042
  my $delete_line_count = 0;
cleanup commit page
Yuki Kimoto authored on 2013-04-12
1043
  for my $line (@$lines) {
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1044
    
added commit page
Yuki Kimoto authored on 2013-01-29
1045
    chomp $line;
1046
    
improved commit page design
Yuki Kimoto authored on 2013-04-12
1047
    my $class;
cleanup commit page
Yuki Kimoto authored on 2013-04-12
1048
    my $before_line_num;
1049
    my $after_line_num;
improved commit page design
Yuki Kimoto authored on 2013-04-12
1050
    
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1051
    if ($line =~ /^@@\s-(\d+)(?:,\d+)?\s\+(\d+)/) {
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1052
      $next_before_line_num = $1;
1053
      $next_after_line_num = $2;
1054
      
1055
      $before_line_num = '...';
1056
      $after_line_num = '...';
1057
      
1058
      $class = 'chunk_header';
1059
    }
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1060
    elsif ($line =~ /^\+\+\+/ || $line =~ /^---/) { next }
1061
    elsif ($line =~ /^\-/) {
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1062
      $class = 'from_file';
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1063
      $before_line_num = $next_before_line_num++;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1064
      $after_line_num = '';
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1065
      $delete_line_count++;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1066
    }
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1067
    elsif ($line =~ /^\+/) {
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1068
      $class = 'to_file';
1069
      $before_line_num = '';
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1070
      $after_line_num = $next_after_line_num++;
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1071
      $add_line_count++;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1072
    }
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1073
    elsif ($line =~ /^Binary files/) {
1074
      $class = 'binary_file';
1075
      $diff_info->{binary} = 1;
1076
    }
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1077
    elsif ($line =~ /^ /) {
1078
      $class = 'diff';
added line number to commit ...
Yuki Kimoto authored on 2013-04-12
1079
      $before_line_num = $next_before_line_num++;
1080
      $after_line_num = $next_after_line_num++;
added line number logic to c...
Yuki Kimoto authored on 2013-04-12
1081
    }
1082
    else { next }
cleanup commit page
Yuki Kimoto authored on 2013-04-12
1083
    
1084
    my $line_data = {
1085
      value => $line,
1086
      class => $class,
1087
      before_line_num => $before_line_num,
1088
      after_line_num => $after_line_num
1089
    };
1090
    push @lines, $line_data;
improved commit page design
Yuki Kimoto authored on 2013-04-12
1091
  }
1092
  
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1093
  # Diff info
1094
  my $diff_line_count = $add_line_count + $delete_line_count;
1095
  my $add_block_count
1096
    = $diff_line_count == 0
1097
    ? 0
1098
    : floor(($add_line_count * 5) / $diff_line_count);
1099
  my $delete_block_count
1100
    = $diff_line_count == 0
1101
    ? 0
1102
    : floor(($delete_line_count * 5) / $diff_line_count);
1103
  
fixed blob diff line number ...
Yuki Kimoto authored on 2013-06-01
1104
  $diff_info->{add_line_count} = $add_line_count;
1105
  $diff_info->{delete_line_count} = $delete_line_count;
1106
  $diff_info->{add_block_count} = $add_block_count;
1107
  $diff_info->{delete_block_count} = $delete_block_count;
1108
  
add diff status bar to commi...
Yuki Kimoto authored on 2013-05-30
1109
  return (\@lines, $diff_info);
improved commit page design
Yuki Kimoto authored on 2013-04-12
1110
}
1111

            
rename parse_commit to get_c...
Yuki Kimoto authored on 2013-05-01
1112
sub get_commit {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1113
  my ($self, $rep_info, $id) = @_;
cleanup branch
Yuki Kimoto authored on 2016-04-16
1114
  
1115
  # Git rev-list
cleanup cmd
Yuki Kimoto authored on 2016-04-16
1116
  my @cmd = $self->cmd(
cleanup methods
Yuki Kimoto authored on 2016-04-16
1117
    $rep_info,
cleanup rep_info
Yuki Kimoto authored on 2016-04-16
1118
    'rev-list',
1119
    '--parents',
1120
    '--header',
1121
    '--max-count=1',
1122
    $id,
1123
    '--'
cleanup branch
Yuki Kimoto authored on 2016-04-16
1124
  );
1125
  open my $fh, '-|', @cmd
1126
    or croak 'Open git-rev-list failed';
1127
  
1128
  # Parse commit
1129
  local $/ = "\0";
1130
  my $content = <$fh>;
1131
  $content = $self->_dec($content);
1132
  return unless defined $content;
1133
  my $commit = $self->parse_commit_text($content, 1);
copy gitweblite soruce code
root authored on 2012-11-23
1134
  close $fh;
1135

            
1136
  return $commit;
1137
}
1138

            
1139
sub parse_commit_text {
1140
  my ($self, $commit_text, $withparents) = @_;
1141
  
1142
  my @commit_lines = split '\n', $commit_text;
1143
  my %commit;
1144

            
1145
  pop @commit_lines; # Remove '\0'
1146
  return unless @commit_lines;
1147

            
1148
  my $header = shift @commit_lines;
1149
  return if $header !~ m/^[0-9a-fA-F]{40}/;
1150
  
1151
  ($commit{id}, my @parents) = split ' ', $header;
1152
  while (my $line = shift @commit_lines) {
1153
    last if $line eq "\n";
1154
    if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
1155
      $commit{tree} = $1;
1156
    } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
1157
      push @parents, $1;
1158
    } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
1159
      $commit{author} = $1;
1160
      $commit{author_epoch} = $2;
1161
      $commit{author_tz} = $3;
1162
      if ($commit{author} =~ m/^([^<]+) <([^>]*)>/) {
1163
        $commit{author_name}  = $1;
1164
        $commit{author_email} = $2;
1165
      } else {
1166
        $commit{author_name} = $commit{author};
1167
      }
1168
    } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
1169
      $commit{committer} = $1;
1170
      $commit{committer_epoch} = $2;
1171
      $commit{committer_tz} = $3;
1172
      if ($commit{committer} =~ m/^([^<]+) <([^>]*)>/) {
1173
        $commit{committer_name}  = $1;
1174
        $commit{committer_email} = $2;
1175
      } else {
1176
        $commit{committer_name} = $commit{committer};
1177
      }
1178
    }
1179
  }
1180
  return unless defined $commit{tree};
1181
  $commit{parents} = \@parents;
1182
  $commit{parent} = $parents[0];
1183

            
1184
  for my $title (@commit_lines) {
1185
    $title =~ s/^    //;
1186
    if ($title ne '') {
1187
      $commit{title} = $self->_chop_str($title, 80, 5);
1188
      # remove leading stuff of merges to make the interesting part visible
1189
      if (length($title) > 50) {
1190
        $title =~ s/^Automatic //;
1191
        $title =~ s/^merge (of|with) /Merge ... /i;
1192
        if (length($title) > 50) {
1193
          $title =~ s/(http|rsync):\/\///;
1194
        }
1195
        if (length($title) > 50) {
1196
          $title =~ s/(master|www|rsync)\.//;
1197
        }
1198
        if (length($title) > 50) {
1199
          $title =~ s/kernel.org:?//;
1200
        }
1201
        if (length($title) > 50) {
1202
          $title =~ s/\/pub\/scm//;
1203
        }
1204
      }
1205
      $commit{title_short} = $self->_chop_str($title, 50, 5);
1206
      last;
1207
    }
1208
  }
1209
  if (! defined $commit{title} || $commit{title} eq '') {
1210
    $commit{title} = $commit{title_short} = '(no commit message)';
1211
  }
1212
  # remove added spaces
1213
  for my $line (@commit_lines) {
1214
    $line =~ s/^    //;
1215
  }
1216
  $commit{comment} = \@commit_lines;
1217

            
1218
  my $age = time - $commit{committer_epoch};
1219
  $commit{age} = $age;
1220
  $commit{age_string} = $self->_age_string($age);
add time zone system
Yuki Kimoto authored on 2014-03-08
1221
  
1222
  # GMT
1223
  {
support atom feed of commits...
Yuki Kimoto authored on 2014-10-03
1224
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($commit{committer_epoch});
add time zone system
Yuki Kimoto authored on 2014-03-08
1225
    $commit{age_string_date} = sprintf '%4d-%02d-%02d', 1900 + $year, $mon + 1, $mday;
1226
    $commit{age_string_datetime} = sprintf '%4d-%02d-%02d %02d:%02d:%02d',
1227
      1900 + $year, $mon + 1, $mday, $hour, $min, $sec;
1228
  }
1229
  
1230
  # Local Time
1231
  {
1232
    my $time_zone_second = $self->time_zone_second || 0;
1233
    
support atom feed of commits...
Yuki Kimoto authored on 2014-10-03
1234
    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
1235
    $commit{age_string_date_local}
1236
      = sprintf '%4d-%02d-%02d', 1900 + $year, $mon + 1, $mday;
support atom feed of commits...
Yuki Kimoto authored on 2014-10-03
1237
    $commit{age_string_datetime_local} = sprintf '%4d-%02d-%02d %02d:%02d:%02d',
add time zone system
Yuki Kimoto authored on 2014-03-08
1238
      1900 + $year, $mon + 1, $mday, $hour, $min, $sec;
1239
  }
support atom feed of commits...
Yuki Kimoto authored on 2014-10-03
1240

            
copy gitweblite soruce code
root authored on 2012-11-23
1241
  return \%commit;
1242
}
1243

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

            
cleanup
Yuki Kimoto authored on 2013-03-19
1247
  # Get Commits
copy gitweblite soruce code
root authored on 2012-11-23
1248
  $maxcount ||= 1;
1249
  $skip ||= 0;
cleanup import_branch
Yuki Kimoto authored on 2016-04-16
1250
  my @cmd = $self->cmd(
1251
    $rep_info,
cleanup
Yuki Kimoto authored on 2013-03-19
1252
    'rev-list',
1253
    '--header',
1254
    @args,
1255
    ('--max-count=' . $maxcount),
1256
    ('--skip=' . $skip),
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1257
    $rev,
cleanup
Yuki Kimoto authored on 2013-03-19
1258
    '--',
added branch long name featu...
Yuki Kimoto authored on 2013-05-12
1259
    (defined $file && length $file ? ($file) : ())
cleanup
Yuki Kimoto authored on 2013-03-19
1260
  );
copy gitweblite soruce code
root authored on 2012-11-23
1261
  open my $fh, '-|', @cmd
1262
    or croak 'Open git-rev-list failed';
cleanup
Yuki Kimoto authored on 2013-03-19
1263
  
1264
  # Prase Commits text
copy gitweblite soruce code
root authored on 2012-11-23
1265
  local $/ = "\0";
1266
  my @commits;
cleanup encoding
Yuki Kimoto authored on 2016-04-05
1267
  my @lines = <$fh>;
1268
  for my $line (@lines) {
1269
    $line = $self->_dec($line);
copy gitweblite soruce code
root authored on 2012-11-23
1270
    my $commit = $self->parse_commit_text($line);
1271
    push @commits, $commit;
1272
  }
1273
  close $fh;
cleanup
Yuki Kimoto authored on 2013-03-19
1274
  
copy gitweblite soruce code
root authored on 2012-11-23
1275
  return \@commits;
1276
}
1277

            
1278
sub parse_date {
1279
  my $self = shift;
1280
  my $epoch = shift;
1281
  my $tz = shift || '-0000';
1282
  
1283
  # Parse data
1284
  my %date;
1285
  my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
1286
  my @days = qw/Sun Mon Tue Wed Thu Fri Sat/;
1287
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime $epoch;
1288
  $date{hour} = $hour;
1289
  $date{minute} = $min;
1290
  $date{mday} = $mday;
1291
  $date{day} = $days[$wday];
1292
  $date{month} = $months[$mon];
1293
  $date{rfc2822} = sprintf '%s, %d %s %4d %02d:%02d:%02d +0000',
1294
    $days[$wday], $mday, $months[$mon], 1900 + $year, $hour ,$min, $sec;
1295
  $date{'mday-time'} = sprintf '%d %s %02d:%02d',
1296
    $mday, $months[$mon], $hour ,$min;
1297
  $date{'iso-8601'}  = sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
1298
    1900 + $year, 1+$mon, $mday, $hour ,$min, $sec;
1299
  my ($tz_sign, $tz_hour, $tz_min) = ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
1300
  $tz_sign = ($tz_sign eq '-' ? -1 : +1);
1301
  my $local = $epoch + $tz_sign * ((($tz_hour*60) + $tz_min) * 60);
1302
  ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime $local;
1303
  $date{hour_local} = $hour;
1304
  $date{minute_local} = $min;
1305
  $date{tz_local} = $tz;
1306
  $date{'iso-tz'} = sprintf('%04d-%02d-%02d %02d:%02d:%02d %s',
1307
    1900 + $year, $mon+1, $mday, $hour, $min, $sec, $tz);
1308
  
1309
  return \%date;
1310
}
1311

            
cleanup
Yuki Kimoto authored on 2013-05-14
1312
sub parsed_diff_tree_line {
copy gitweblite soruce code
root authored on 2012-11-23
1313
  my ($self, $line) = @_;
1314
  
1315
  return $line if ref $line eq 'HASH';
1316

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

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

            
1323
  my %res;
1324
  if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
1325
    $res{from_mode} = $1;
1326
    $res{to_mode} = $2;
1327
    $res{from_id} = $3;
1328
    $res{to_id} = $4;
1329
    $res{status} = $5;
1330
    $res{similarity} = $6;
1331
    if ($res{status} eq 'R' || $res{status} eq 'C') {
1332
      ($res{from_file}, $res{to_file}) = map { $self->_unquote($_) } split("\t", $7);
1333
    } else {
1334
      $res{from_file} = $res{to_file} = $res{file} = $self->_unquote($7);
1335
    }
1336
  }
1337
  elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
1338
    $res{nparents}  = length($1);
1339
    $res{from_mode} = [ split(' ', $2) ];
1340
    $res{to_mode} = pop @{$res{from_mode}};
1341
    $res{from_id} = [ split(' ', $3) ];
1342
    $res{to_id} = pop @{$res{from_id}};
1343
    $res{status} = [ split('', $4) ];
1344
    $res{to_file} = $self->_unquote($5);
1345
  }
1346
  elsif ($line =~ m/^([0-9a-fA-F]{40})$/) { $res{commit} = $1 }
1347

            
1348
  return \%res;
1349
}
1350

            
1351
sub parse_ls_tree_line {
1352
  my ($self, $line) = @_;
1353
  my %opts = @_;
1354
  my %res;
1355

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

            
1359
    $res{mode} = $1;
1360
    $res{type} = $2;
1361
    $res{hash} = $3;
1362
    $res{size} = $4;
1363
    if ($opts{'-z'}) { $res{name} = $5 }
1364
    else { $res{name} = $self->_unquote($5) }
1365
  }
1366
  else {
1367
    $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
1368

            
1369
    $res{mode} = $1;
1370
    $res{type} = $2;
1371
    $res{hash} = $3;
1372
    if ($opts{'-z'}) { $res{name} = $4 }
1373
    else { $res{name} = $self->_unquote($4) }
1374
  }
1375

            
1376
  return \%res;
1377
}
1378

            
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1379
sub import_branch {
cleanup import_branch
Yuki Kimoto authored on 2016-04-16
1380
  my ($self, $rep_info, $branch, $remote_rep_info, $remote_branch, $opt) = @_;
complete branch import featu...
Yuki Kimoto authored on 2013-08-15
1381
  
1382
  my $force = $opt->{force};
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1383
  
1384
  # Git pull
cleanup import_branch
Yuki Kimoto authored on 2016-04-16
1385
  my $remote_rep = $remote_rep_info->{git_dir};
1386
  my @cmd = $self->cmd(
1387
    $rep_info,
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1388
    'fetch',
1389
    $remote_rep,
complete branch import featu...
Yuki Kimoto authored on 2013-08-15
1390
    ($force ? '+' : '') . "refs/heads/$remote_branch:refs/heads/$branch"
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1391
  );
1392
  
fix bug that in CGI reposito...
Yuki Kimoto authored on 2015-11-05
1393
  Gitprep::Util::run_command(@cmd)
complete branch import featu...
Yuki Kimoto authored on 2013-08-15
1394
    or croak 'Open git fetch for import_branch failed';
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1395
}
1396

            
copy gitweblite soruce code
root authored on 2012-11-23
1397
sub search_bin {
1398
  my $self = shift;
1399
  
1400
  # Search git bin
1401
  my $env_path = $ENV{PATH};
1402
  my @paths = split /:/, $env_path;
1403
  for my $path (@paths) {
1404
    $path =~ s#/$##;
1405
    my $bin = "$path/git";
1406
    if (-f $bin) {
1407
      return $bin;
1408
      last;
1409
    }
1410
  }
improved git path searching
Yuki Kimoto authored on 2012-11-23
1411
  
1412
  my $local_bin = '/usr/local/bin/git';
1413
  return $local_bin if -f $local_bin;
1414
  
1415
  my $bin = '/usr/bin/git';
1416
  return $bin if -f $bin;
1417
  
copy gitweblite soruce code
root authored on 2012-11-23
1418
  return;
1419
}
1420

            
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1421
sub separated_commit {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1422
  my ($self, $rep_info, $rev1, $rev2) = @_;
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1423
  
1424
  # Command "git diff-tree"
cleanup methods
Yuki Kimoto authored on 2016-04-16
1425
  my @cmd = $self->cmd(
1426
    $rep_info,
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1427
    'show-branch',
1428
    $rev1,
1429
    $rev2
1430
  );
1431
  open my $fh, "-|", @cmd
1432
    or croak 500, "Open git-show-branch failed";
1433

            
1434
  my $commits = [];
1435
  my $start;
1436
  my @lines = <$fh>;
1437
  my $last_line = pop @lines;
1438
  my $commit;
1439
  if (defined $last_line) {
1440
      my ($id) = $last_line =~ /^.*?\[(.+)?\]/;
cleanup methods
Yuki Kimoto authored on 2016-04-16
1441
      $commit = $self->get_commit($rep_info, $id);
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1442
  }
1443

            
1444
  return $commit;
1445
}
1446

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

            
1450
  my $name = $project;
1451
  $name =~ s,([^/])/*\.git$,$1,;
1452
  $name = basename($name);
1453
  # sanitize name
1454
  $name =~ s/[[:cntrl:]]/?/g;
1455

            
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1456
  my $ver = $rev;
1457
  if ($rev =~ /^[0-9a-fA-F]+$/) {
1458
    my $full_hash = $self->id($project, $rev);
1459
    if ($full_hash =~ /^$rev/ && length($rev) > 7) {
1460
      $ver = $self->short_id($project, $rev);
copy gitweblite soruce code
root authored on 2012-11-23
1461
    }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1462
  } elsif ($rev =~ m!^refs/tags/(.*)$!) {
copy gitweblite soruce code
root authored on 2012-11-23
1463
    $ver = $1;
1464
  } else {
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1465
    if ($rev =~ m!^refs/(?:heads|remotes)/(.*)$!) {
copy gitweblite soruce code
root authored on 2012-11-23
1466
      $ver = $1;
1467
    }
impved merge commit logic
Yuki Kimoto authored on 2013-06-01
1468
    $ver .= '-' . $self->short_id($project, $rev);
copy gitweblite soruce code
root authored on 2012-11-23
1469
  }
1470
  $ver =~ s!/!.!g;
1471

            
1472
  $name = "$name-$ver";
1473

            
1474
  return wantarray ? ($name, $name) : $name;
1475
}
1476

            
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1477
sub timestamp {
1478
  my ($self, $date) = @_;
1479
  
1480
  # Time stamp
1481
  my $strtime = $date->{rfc2822};
1482
  my $localtime_format = '(%02d:%02d %s)';
1483
  if ($date->{hour_local} < 6) { $localtime_format = '(%02d:%02d %s)' }
1484
  $strtime .= ' ' . sprintf(
1485
    $localtime_format,
1486
    $date->{hour_local},
1487
    $date->{minute_local},
1488
    $date->{tz_local}
1489
  );
1490

            
1491
  return $strtime;
1492
}
1493

            
1494
sub trees {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1495
  my ($self, $rep_info, $rev, $dir) = @_;
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1496
  $dir = '' unless defined $dir;
1497
  
1498
  # Get tree
1499
  my $tid;
1500
  if (defined $dir && $dir ne '') {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1501
    $tid = $self->path_to_hash($rep_info, $rev, $dir, 'tree');
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1502
  }
1503
  else {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1504
    my $commit = $self->get_commit($rep_info, $rev);
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1505
    $tid = $commit->{tree};
1506
  }
1507
  my @entries = ();
1508
  my $show_sizes = 0;
cleanup methods
Yuki Kimoto authored on 2016-04-16
1509
  my @cmd = $self->cmd(
1510
    $rep_info,
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1511
    'ls-tree',
1512
    '-z',
1513
    ($show_sizes ? '-l' : ()),
1514
    $tid
1515
  );
1516
  open my $fh, '-|', @cmd
1517
    or $self->croak('Open git-ls-tree failed');
1518
  {
1519
    local $/ = "\0";
cleanup encoding
Yuki Kimoto authored on 2016-04-05
1520
    @entries = <$fh>;
1521
    @entries = map { chomp; $self->_dec($_) } @entries;
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1522
  }
1523
  close $fh
1524
    or $self->croak(404, "Reading tree failed");
1525

            
1526
  # Parse tree
1527
  my $trees;
1528
  for my $line (@entries) {
1529
    my $tree = $self->parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
1530
    $tree->{mode_str} = $self->_mode_str($tree->{mode});
1531
    
1532
    # Commit log
1533
    my $path = defined $dir && $dir ne '' ? "$dir/$tree->{name}" : $tree->{name};
cleanup methods
Yuki Kimoto authored on 2016-04-16
1534
    my $commit = $self->last_change_commit($rep_info, $rev, $path);
change pull feature to impor...
Yuki Kimoto authored on 2013-08-14
1535
    $tree->{commit} = $commit;
1536
    
1537
    push @$trees, $tree;
1538
  }
1539
  $trees = [sort {$b->{type} cmp $a->{type} || $a->{name} cmp $b->{name}} @$trees];
1540
  
1541
  return $trees;
1542
}
1543

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

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

            
copy gitweblite soruce code
root authored on 2012-11-23
1550
sub _age_string {
1551
  my ($self, $age) = @_;
1552
  my $age_str;
1553

            
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1554
  if ($age >= 60 * 60 * 24 * 365) {
refactored
Xavier Caron authored on 2013-08-30
1555
    $age_str = $self->_age_ago(year => (int $age/60/60/24/365));
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1556
  } elsif ($age >= 60 * 60 * 24 * (365/12)) {
refactored
Xavier Caron authored on 2013-08-30
1557
    $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
1558
  } elsif ($age >= 60 * 60 * 24 * 7) {
refactored
Xavier Caron authored on 2013-08-30
1559
    $age_str = $self->_age_ago(week => int $age/60/60/24/7);
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1560
  } elsif ($age >= 60 * 60 * 24) {
refactored
Xavier Caron authored on 2013-08-30
1561
    $age_str = $self->_age_ago(day => int $age/60/60/24);
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1562
  } elsif ($age >= 60 * 60) {
refactored
Xavier Caron authored on 2013-08-30
1563
    $age_str = $self->_age_ago(hour => int $age/60/60);
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1564
  } elsif ($age >= 60) {
refactored
Xavier Caron authored on 2013-08-30
1565
    $age_str = $self->_age_ago(min => int $age/60);
added commit datetime to pro...
Yuki Kimoto authored on 2013-05-03
1566
  } elsif ($age >= 1) {
refactored
Xavier Caron authored on 2013-08-30
1567
    $age_str = $self->_age_ago(sec => int $age);
copy gitweblite soruce code
root authored on 2012-11-23
1568
  } else {
fixed a typo
Xavier Caron authored on 2013-08-30
1569
    $age_str .= 'right now';
copy gitweblite soruce code
root authored on 2012-11-23
1570
  }
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
1571
  
1572
  $age_str =~ s/^1 /a /;
more phonetically correct
Xavier Caron authored on 2013-08-30
1573
  $age_str =~ s/^a hour/an hour/;
cleanup blob and raw page
Yuki Kimoto authored on 2013-05-02
1574
  
copy gitweblite soruce code
root authored on 2012-11-23
1575
  return $age_str;
1576
}
1577

            
1578
sub _chop_str {
1579
  my $self = shift;
1580
  my $str = shift;
1581
  my $len = shift;
1582
  my $add_len = shift || 10;
1583
  my $where = shift || 'right';
1584

            
1585
  if ($where eq 'center') {
1586
    # Filler is length 5
1587
    return $str if ($len + 5 >= length($str));
1588
    $len = int($len/2);
1589
  } else {
1590
    # Filler is length 4
1591
    return $str if ($len + 4 >= length($str)); 
1592
  }
1593

            
1594
  # Regexps: ending and beginning with word part up to $add_len
1595
  my $endre = qr/.{$len}\w{0,$add_len}/;
1596
  my $begre = qr/\w{0,$add_len}.{$len}/;
1597

            
1598
  if ($where eq 'left') {
1599
    $str =~ m/^(.*?)($begre)$/;
1600
    my ($lead, $body) = ($1, $2);
1601
    if (length($lead) > 4) {
1602
      $lead = ' ...';
1603
    }
1604
    return "$lead$body";
1605

            
1606
  } elsif ($where eq 'center') {
1607
    $str =~ m/^($endre)(.*)$/;
1608
    my ($left, $str)  = ($1, $2);
1609
    $str =~ m/^(.*?)($begre)$/;
1610
    my ($mid, $right) = ($1, $2);
1611
    if (length($mid) > 5) {
1612
      $mid = ' ... ';
1613
    }
1614
    return "$left$mid$right";
1615

            
1616
  } else {
1617
    $str =~ m/^($endre)(.*)$/;
1618
    my $body = $1;
1619
    my $tail = $2;
1620
    if (length($tail) > 4) {
1621
      $tail = '... ';
1622
    }
1623
    return "$body$tail";
1624
  }
1625
}
1626

            
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1627
sub decide_encoding {
cleanup methods
Yuki Kimoto authored on 2016-04-16
1628
  my ($self, $rep_info, $lines) = @_;
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1629
  
1630
  my $guess_encoding_str = $self->app->dbi->model('project')->select(
1631
    'guess_encoding',
cleanup methods
Yuki Kimoto authored on 2016-04-16
1632
    where => {user_id => $rep_info->{user}, name => $rep_info->{project}}
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1633
  )->value;
cleanup encoding_suspects
Yuki Kimoto authored on 2016-04-05
1634
  
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1635
  my @guess_encodings;
cleanup blame
Yuki Kimoto authored on 2016-04-16
1636
  if (defined $guess_encoding_str && length $guess_encoding_str) {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1637
    @guess_encodings = split(/\s*,\s*/, $guess_encoding_str);
1638
  }
cleanup encoding_suspects
Yuki Kimoto authored on 2016-04-05
1639
  
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1640
  my $encoding;
1641
  if (@guess_encodings) {
1642
    my @new_lines;
1643
    for (my $i = 0; $i < 100; $i++) {
1644
      last unless defined $lines->[$i];
1645
      push @new_lines, $lines->[$i];
1646
    }
1647
    
1648
    my $str = join('', @new_lines);
1649

            
1650
    my $ret = Encode::Guess->guess($str, @guess_encodings);
1651
    
improve dec_guess logic
Yuki Kimoto authored on 2016-04-05
1652
    if (ref $ret) {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1653
      $encoding = $ret->name;
improve dec_guess logic
Yuki Kimoto authored on 2016-04-05
1654
    }
1655
    else {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1656
      $encoding = $self->default_encoding
cleanup encoding_suspects
Yuki Kimoto authored on 2016-04-05
1657
    }
1658
  }
1659
  else {
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1660
    $encoding = $self->default_encoding;
cleanup encoding_suspects
Yuki Kimoto authored on 2016-04-05
1661
  }
1662
  
remove [basic]encoding_suspe...
Yuki Kimoto authored on 2016-04-06
1663
  return $encoding;
Supported specific character...
Tetsuya Hayashi authored on 2014-03-15
1664
}
1665

            
cleanuP
Yuki Kimoto authored on 2016-04-16
1666
sub _age_string_date {
1667
  my ($self, $age) = @_;
1668

            
1669
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age);
1670
  my $age_string_date = sprintf '%4d-%02d-%02d', 1900 + $year, $mon + 1, $mday;
1671
  
1672
  return $age_string_date;
1673
}
1674

            
1675
sub _age_string_date_local {
1676
  my ($self, $age) = @_;
1677
  
1678
  my $time_zone_second = $self->time_zone_second || 0;
1679
  
1680
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age + $time_zone_second);
1681
  my $age_string_date_local = sprintf '%4d-%02d-%02d', 1900 + $year, $mon + 1, $mday;
1682
  
1683
  return $age_string_date_local;
1684
}
1685

            
cleanup
Yuki Kimoto authored on 2013-05-14
1686
sub _dec {
revert encoding support
Yuki Kimoto authored on 2013-11-22
1687
  my ($self, $str) = @_;
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1688
  
Renamed encoding to default_...
Tetsuya Hayashi authored on 2014-03-15
1689
  my $enc = $self->default_encoding;
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1690
  
cleanup encoding logic
Yuki Kimoto authored on 2016-04-05
1691
  $str = decode($enc, $str);
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1692
  
cleanup encoding logic
Yuki Kimoto authored on 2016-04-05
1693
  return $str;
added README commited rep fe...
Yuki Kimoto authored on 2013-03-28
1694
}
1695

            
revert encoding support
Yuki Kimoto authored on 2013-11-22
1696
sub _enc {
1697
  my ($self, $str) = @_;
1698
  
Renamed encoding to default_...
Tetsuya Hayashi authored on 2014-03-15
1699
  my $enc = $self->default_encoding;
revert encoding support
Yuki Kimoto authored on 2013-11-22
1700
  
1701
  return encode($enc, $str);
1702
}
1703

            
improved create repository f...
Yuki Kimoto authored on 2013-03-21
1704
sub _mode_str {
1705
  my $self = shift;
1706
  my $mode = oct shift;
1707

            
1708
  # Mode to string
1709
  if ($self->_s_isgitlink($mode)) { return 'm---------' }
1710
  elsif (S_ISDIR($mode & S_IFMT)) { return 'drwxr-xr-x' }
1711
  elsif (S_ISLNK($mode)) { return 'lrwxrwxrwx' }
1712
  elsif (S_ISREG($mode)) {
1713
    if ($mode & S_IXUSR) {
1714
      return '-rwxr-xr-x';
1715
    } else {
1716
      return '-rw-r--r--'
1717
    }
1718
  } else { return '----------' }
1719
  
1720
  return;
1721
}
1722

            
1723
sub _s_isgitlink {
1724
  my ($self, $mode) = @_;
1725
  
1726
  # Check if git link
1727
  my $s_ifgitlink = 0160000;
1728
  return (($mode & S_IFMT) == $s_ifgitlink)
copy gitweblite soruce code
root authored on 2012-11-23
1729
}
1730

            
1731
sub _slurp {
1732
  my ($self, $file) = @_;
1733
  
1734
  # Slurp
1735
  open my $fh, '<', $file
1736
    or croak qq/Can't open file "$file": $!/;
cleanup
Yuki Kimoto authored on 2013-11-16
1737
  my $content = do { local $/; scalar <$fh> };
copy gitweblite soruce code
root authored on 2012-11-23
1738
  close $fh;
1739
  
1740
  return $content;
1741
}
1742

            
1743
sub _unquote {
1744
  my ($self, $str) = @_;
1745
  
1746
  # Unquote function
1747
  my $unq = sub {
1748
    my $seq = shift;
1749
    my %escapes = (
1750
      t => "\t",
1751
      n => "\n",
1752
      r => "\r",
1753
      f => "\f",
1754
      b => "\b",
1755
      a => "\a",
1756
      e => "\e",
1757
      v => "\013",
1758
    );
1759

            
1760
    if ($seq =~ m/^[0-7]{1,3}$/) { return chr oct $seq }
1761
    elsif (exists $escapes{$seq}) { return $escapes{$seq} }
1762
    
1763
    return $seq;
1764
  };
1765
  
1766
  # Unquote
1767
  if ($str =~ m/^"(.*)"$/) {
1768
    $str = $1;
1769
    $str =~ s/\\([^0-7]|[0-7]{1,3})/$unq->($1)/eg;
1770
  }
1771
  
1772
  return $str;
1773
}
1774

            
1775
1;