Teach read-tree the -n|--dry-run option
[gitweb.git] / gitweb / gitweb.perl
index f8db40a1c25a2cdf1c4dc1ff42aba0fe66ef8f1c..66eadb4ab2939b193fcf84d8d805e0b29ad5e9d2 100755 (executable)
@@ -412,20 +412,23 @@ sub evaluate_uri {
                'override' => 0,
                'default' => []},
 
-       # Allow gitweb scan project content tags described in ctags/
-       # of project repository, and display the popular Web 2.0-ish
-       # "tag cloud" near the project list. Note that this is something
-       # COMPLETELY different from the normal Git tags.
+       # Allow gitweb scan project content tags of project repository,
+       # and display the popular Web 2.0-ish "tag cloud" near the projects
+       # list.  Note that this is something COMPLETELY different from the
+       # normal Git tags.
 
        # gitweb by itself can show existing tags, but it does not handle
-       # tagging itself; you need an external application for that.
-       # For an example script, check Girocco's cgi/tagproj.cgi.
+       # tagging itself; you need to do it externally, outside gitweb.
+       # The format is described in git_get_project_ctags() subroutine.
        # You may want to install the HTML::TagCloud Perl module to get
        # a pretty tag cloud instead of just a list of tags.
 
        # To enable system wide have in $GITWEB_CONFIG
-       # $feature{'ctags'}{'default'} = ['path_to_tag_script'];
+       # $feature{'ctags'}{'default'} = [1];
        # Project specific override is not supported.
+
+       # In the future whether ctags editing is enabled might depend
+       # on the value, but using 1 should always mean no editing of ctags.
        'ctags' => {
                'override' => 0,
                'default' => [0]},
@@ -703,6 +706,7 @@ sub check_loadavg {
        snapshot_format => "sf",
        extra_options => "opt",
        search_use_regexp => "sr",
+       ctag => "by_tag",
        # this must be last entry (for manipulation from JavaScript)
        javascript => "js"
 );
@@ -2572,23 +2576,66 @@ sub git_get_project_description {
        return $descr;
 }
 
+# supported formats:
+# * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
+#   - if its contents is a number, use it as tag weight,
+#   - otherwise add a tag with weight 1
+# * $GIT_DIR/ctags file, each line is a tag (with weight 1)
+#   the same value multiple times increases tag weight
+# * `gitweb.ctag' multi-valued repo config variable
 sub git_get_project_ctags {
-       my $path = shift;
+       my $project = shift;
        my $ctags = {};
 
-       $git_dir = "$projectroot/$path";
-       opendir my $dh, "$git_dir/ctags"
-               or return $ctags;
-       foreach (grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh)) {
-               open my $ct, '<', $_ or next;
-               my $val = <$ct>;
-               chomp $val;
-               close $ct;
-               my $ctag = $_; $ctag =~ s#.*/##;
-               $ctags->{$ctag} = $val;
+       $git_dir = "$projectroot/$project";
+       if (opendir my $dh, "$git_dir/ctags") {
+               my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
+               foreach my $tagfile (@files) {
+                       open my $ct, '<', $tagfile
+                               or next;
+                       my $val = <$ct>;
+                       chomp $val if $val;
+                       close $ct;
+
+                       (my $ctag = $tagfile) =~ s#.*/##;
+                       if ($val =~ /\d+/) {
+                               $ctags->{$ctag} = $val;
+                       } else {
+                               $ctags->{$ctag} = 1;
+                       }
+               }
+               closedir $dh;
+
+       } elsif (open my $fh, '<', "$git_dir/ctags") {
+               while (my $line = <$fh>) {
+                       chomp $line;
+                       $ctags->{$line}++ if $line;
+               }
+               close $fh;
+
+       } else {
+               my $taglist = config_to_multi(git_get_project_config('ctag'));
+               foreach my $tag (@$taglist) {
+                       $ctags->{$tag}++;
+               }
        }
-       closedir $dh;
-       $ctags;
+
+       return $ctags;
+}
+
+# return hash, where keys are content tags ('ctags'),
+# and values are sum of weights of given tag in every project
+sub git_gather_all_ctags {
+       my $projects = shift;
+       my $ctags = {};
+
+       foreach my $p (@$projects) {
+               foreach my $ct (keys %{$p->{'ctags'}}) {
+                       $ctags->{$ct} += $p->{'ctags'}->{$ct};
+               }
+       }
+
+       return $ctags;
 }
 
 sub git_populate_project_tagcloud {
@@ -2606,33 +2653,49 @@ sub git_populate_project_tagcloud {
        }
 
        my $cloud;
+       my $matched = $cgi->param('by_tag');
        if (eval { require HTML::TagCloud; 1; }) {
                $cloud = HTML::TagCloud->new;
-               foreach (sort keys %ctags_lc) {
+               foreach my $ctag (sort keys %ctags_lc) {
                        # Pad the title with spaces so that the cloud looks
                        # less crammed.
-                       my $title = $ctags_lc{$_}->{topname};
+                       my $title = esc_html($ctags_lc{$ctag}->{topname});
                        $title =~ s/ /&nbsp;/g;
                        $title =~ s/^/&nbsp;/g;
                        $title =~ s/$/&nbsp;/g;
-                       $cloud->add($title, $home_link."?by_tag=".$_, $ctags_lc{$_}->{count});
+                       if (defined $matched && $matched eq $ctag) {
+                               $title = qq(<span class="match">$title</span>);
+                       }
+                       $cloud->add($title, href(project=>undef, ctag=>$ctag),
+                                   $ctags_lc{$ctag}->{count});
                }
        } else {
-               $cloud = \%ctags_lc;
+               $cloud = {};
+               foreach my $ctag (keys %ctags_lc) {
+                       my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
+                       if (defined $matched && $matched eq $ctag) {
+                               $title = qq(<span class="match">$title</span>);
+                       }
+                       $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
+                       $cloud->{$ctag}{ctag} =
+                               $cgi->a({-href=>href(project=>undef, ctag=>$ctag)}, $title);
+               }
        }
-       $cloud;
+       return $cloud;
 }
 
 sub git_show_project_tagcloud {
        my ($cloud, $count) = @_;
-       print STDERR ref($cloud)."..\n";
        if (ref $cloud eq 'HTML::TagCloud') {
                return $cloud->html_and_css($count);
        } else {
-               my @tags = sort { $cloud->{$a}->{count} <=> $cloud->{$b}->{count} } keys %$cloud;
-               return '<p align="center">' . join (', ', map {
-                       $cgi->a({-href=>"$home_link?by_tag=$_"}, $cloud->{$_}->{topname})
-               } splice(@tags, 0, $count)) . '</p>';
+               my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
+               return
+                       '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
+                       join (', ', map {
+                               $cloud->{$_}->{'ctag'}
+                       } splice(@tags, 0, $count)) .
+                       '</div>';
        }
 }
 
@@ -2651,21 +2714,23 @@ sub git_get_project_url_list {
 }
 
 sub git_get_projects_list {
-       my ($filter) = @_;
+       my $filter = shift || '';
        my @list;
 
-       $filter ||= '';
        $filter =~ s/\.git$//;
 
-       my $check_forks = gitweb_check_feature('forks');
-
        if (-d $projects_list) {
                # search in directory
-               my $dir = $projects_list . ($filter ? "/$filter" : '');
+               my $dir = $projects_list;
                # remove the trailing "/"
                $dir =~ s!/+$!!;
-               my $pfxlen = length("$dir");
-               my $pfxdepth = ($dir =~ tr!/!!);
+               my $pfxlen = length("$projects_list");
+               my $pfxdepth = ($projects_list =~ tr!/!!);
+               # when filtering, search only given subdirectory
+               if ($filter) {
+                       $dir .= "/$filter";
+                       $dir =~ s!/+$!!;
+               }
 
                File::Find::find({
                        follow_fast => 1, # follow symbolic links
@@ -2680,14 +2745,14 @@ sub git_get_projects_list {
                                # only directories can be git repositories
                                return unless (-d $_);
                                # don't traverse too deep (Find is super slow on os x)
+                               # $project_maxdepth excludes depth of $projectroot
                                if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
                                        $File::Find::prune = 1;
                                        return;
                                }
 
-                               my $subdir = substr($File::Find::name, $pfxlen + 1);
+                               my $path = substr($File::Find::name, $pfxlen + 1);
                                # we check related file in $projectroot
-                               my $path = ($filter ? "$filter/" : '') . $subdir;
                                if (check_export_ok("$projectroot/$path")) {
                                        push @list, { path => $path };
                                        $File::Find::prune = 1;
@@ -2700,7 +2765,6 @@ sub git_get_projects_list {
                # 'git%2Fgit.git Linus+Torvalds'
                # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
                # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
-               my %paths;
                open my $fd, '<', $projects_list or return;
        PROJECT:
                while (my $line = <$fd>) {
@@ -2711,32 +2775,9 @@ sub git_get_projects_list {
                        if (!defined $path) {
                                next;
                        }
-                       if ($filter ne '') {
-                               # looking for forks;
-                               my $pfx = substr($path, 0, length($filter));
-                               if ($pfx ne $filter) {
-                                       next PROJECT;
-                               }
-                               my $sfx = substr($path, length($filter));
-                               if ($sfx !~ /^\/.*\.git$/) {
-                                       next PROJECT;
-                               }
-                       } elsif ($check_forks) {
-                       PATH:
-                               foreach my $filter (keys %paths) {
-                                       # looking for forks;
-                                       my $pfx = substr($path, 0, length($filter));
-                                       if ($pfx ne $filter) {
-                                               next PATH;
-                                       }
-                                       my $sfx = substr($path, length($filter));
-                                       if ($sfx !~ /^\/.*\.git$/) {
-                                               next PATH;
-                                       }
-                                       # is a fork, don't include it in
-                                       # the list
-                                       next PROJECT;
-                               }
+                       # if $filter is rpovided, check if $path begins with $filter
+                       if ($filter && $path !~ m!^\Q$filter\E/!) {
+                               next;
                        }
                        if (check_export_ok("$projectroot/$path")) {
                                my $pr = {
@@ -2744,8 +2785,6 @@ sub git_get_projects_list {
                                        owner => to_utf8($owner),
                                };
                                push @list, $pr;
-                               (my $forks_path = $path) =~ s/\.git$//;
-                               $paths{$forks_path}++;
                        }
                }
                close $fd;
@@ -2753,6 +2792,98 @@ sub git_get_projects_list {
        return @list;
 }
 
+# written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
+# as side effects it sets 'forks' field to list of forks for forked projects
+sub filter_forks_from_projects_list {
+       my $projects = shift;
+
+       my %trie; # prefix tree of directories (path components)
+       # generate trie out of those directories that might contain forks
+       foreach my $pr (@$projects) {
+               my $path = $pr->{'path'};
+               $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
+               next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
+               next unless ($path);      # skip '.git' repository: tests, git-instaweb
+               next unless (-d $path);   # containing directory exists
+               $pr->{'forks'} = [];      # there can be 0 or more forks of project
+
+               # add to trie
+               my @dirs = split('/', $path);
+               # walk the trie, until either runs out of components or out of trie
+               my $ref = \%trie;
+               while (scalar @dirs &&
+                      exists($ref->{$dirs[0]})) {
+                       $ref = $ref->{shift @dirs};
+               }
+               # create rest of trie structure from rest of components
+               foreach my $dir (@dirs) {
+                       $ref = $ref->{$dir} = {};
+               }
+               # create end marker, store $pr as a data
+               $ref->{''} = $pr if (!exists $ref->{''});
+       }
+
+       # filter out forks, by finding shortest prefix match for paths
+       my @filtered;
+ PROJECT:
+       foreach my $pr (@$projects) {
+               # trie lookup
+               my $ref = \%trie;
+       DIR:
+               foreach my $dir (split('/', $pr->{'path'})) {
+                       if (exists $ref->{''}) {
+                               # found [shortest] prefix, is a fork - skip it
+                               push @{$ref->{''}{'forks'}}, $pr;
+                               next PROJECT;
+                       }
+                       if (!exists $ref->{$dir}) {
+                               # not in trie, cannot have prefix, not a fork
+                               push @filtered, $pr;
+                               next PROJECT;
+                       }
+                       # If the dir is there, we just walk one step down the trie.
+                       $ref = $ref->{$dir};
+               }
+               # we ran out of trie
+               # (shouldn't happen: it's either no match, or end marker)
+               push @filtered, $pr;
+       }
+
+       return @filtered;
+}
+
+# note: fill_project_list_info must be run first,
+# for 'descr_long' and 'ctags' to be filled
+sub search_projects_list {
+       my ($projlist, %opts) = @_;
+       my $tagfilter  = $opts{'tagfilter'};
+       my $searchtext = $opts{'searchtext'};
+
+       return @$projlist
+               unless ($tagfilter || $searchtext);
+
+       my @projects;
+ PROJECT:
+       foreach my $pr (@$projlist) {
+
+               if ($tagfilter) {
+                       next unless ref($pr->{'ctags'}) eq 'HASH';
+                       next unless
+                               grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
+               }
+
+               if ($searchtext) {
+                       next unless
+                               $pr->{'path'} =~ /$searchtext/ ||
+                               $pr->{'descr_long'} =~ /$searchtext/;
+               }
+
+               push @projects, $pr;
+       }
+
+       return @projects;
+}
+
 our $gitweb_project_owner = undef;
 sub git_get_project_list_from_file {
 
@@ -4742,7 +4873,7 @@ sub git_patchset_body {
 # project in the list, removing invalid projects from returned list
 # NOTE: modifies $projlist, but does not remove entries from it
 sub fill_project_list_info {
-       my ($projlist, $check_forks) = @_;
+       my $projlist = shift;
        my @projects;
 
        my $show_ctags = gitweb_check_feature('ctags');
@@ -4762,23 +4893,36 @@ sub fill_project_list_info {
                if (!defined $pr->{'owner'}) {
                        $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
                }
-               if ($check_forks) {
-                       my $pname = $pr->{'path'};
-                       if (($pname =~ s/\.git$//) &&
-                           ($pname !~ /\/$/) &&
-                           (-d "$projectroot/$pname")) {
-                               $pr->{'forks'} = "-d $projectroot/$pname";
-                       } else {
-                               $pr->{'forks'} = 0;
-                       }
+               if ($show_ctags) {
+                       $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
                }
-               $show_ctags and $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
                push @projects, $pr;
        }
 
        return @projects;
 }
 
+sub sort_projects_list {
+       my ($projlist, $order) = @_;
+       my @projects;
+
+       my %order_info = (
+               project => { key => 'path', type => 'str' },
+               descr => { key => 'descr_long', type => 'str' },
+               owner => { key => 'owner', type => 'str' },
+               age => { key => 'age', type => 'num' }
+       );
+       my $oi = $order_info{$order};
+       return @$projlist unless defined $oi;
+       if ($oi->{'type'} eq 'str') {
+               @projects = sort {$a->{$oi->{'key'}} cmp $b->{$oi->{'key'}}} @$projlist;
+       } else {
+               @projects = sort {$a->{$oi->{'key'}} <=> $b->{$oi->{'key'}}} @$projlist;
+       }
+
+       return @projects;
+}
+
 # print 'sort by' <th> element, generating 'sort by $name' replay link
 # if that order is not selected
 sub print_sort_th {
@@ -4805,36 +4949,42 @@ sub format_sort_th {
 sub git_project_list_body {
        # actually uses global variable $project
        my ($projlist, $order, $from, $to, $extra, $no_header) = @_;
+       my @projects = @$projlist;
 
        my $check_forks = gitweb_check_feature('forks');
-       my @projects = fill_project_list_info($projlist, $check_forks);
+       my $show_ctags  = gitweb_check_feature('ctags');
+       my $tagfilter = $show_ctags ? $cgi->param('by_tag') : undef;
+       $check_forks = undef
+               if ($tagfilter || $searchtext);
+
+       # filtering out forks before filling info allows to do less work
+       @projects = filter_forks_from_projects_list(\@projects)
+               if ($check_forks);
+       @projects = fill_project_list_info(\@projects);
+       # searching projects require filling to be run before it
+       @projects = search_projects_list(\@projects,
+                                        'searchtext' => $searchtext,
+                                        'tagfilter'  => $tagfilter)
+               if ($tagfilter || $searchtext);
 
        $order ||= $default_projects_order;
        $from = 0 unless defined $from;
        $to = $#projects if (!defined $to || $#projects < $to);
 
-       my %order_info = (
-               project => { key => 'path', type => 'str' },
-               descr => { key => 'descr_long', type => 'str' },
-               owner => { key => 'owner', type => 'str' },
-               age => { key => 'age', type => 'num' }
-       );
-       my $oi = $order_info{$order};
-       if ($oi->{'type'} eq 'str') {
-               @projects = sort {$a->{$oi->{'key'}} cmp $b->{$oi->{'key'}}} @projects;
-       } else {
-               @projects = sort {$a->{$oi->{'key'}} <=> $b->{$oi->{'key'}}} @projects;
+       # short circuit
+       if ($from > $to) {
+               print "<center>\n".
+                     "<b>No such projects found</b><br />\n".
+                     "Click ".$cgi->a({-href=>href(project=>undef)},"here")." to view all projects<br />\n".
+                     "</center>\n<br />\n";
+               return;
        }
 
-       my $show_ctags = gitweb_check_feature('ctags');
+       @projects = sort_projects_list(\@projects, $order);
+
        if ($show_ctags) {
-               my %ctags;
-               foreach my $p (@projects) {
-                       foreach my $ct (keys %{$p->{'ctags'}}) {
-                               $ctags{$ct} += $p->{'ctags'}->{$ct};
-                       }
-               }
-               my $cloud = git_populate_project_tagcloud(\%ctags);
+               my $ctags = git_gather_all_ctags(\@projects);
+               my $cloud = git_populate_project_tagcloud($ctags);
                print git_show_project_tagcloud($cloud, 64);
        }
 
@@ -4852,32 +5002,26 @@ sub git_project_list_body {
                      "</tr>\n";
        }
        my $alternate = 1;
-       my $tagfilter = $cgi->param('by_tag');
        for (my $i = $from; $i <= $to; $i++) {
                my $pr = $projects[$i];
 
-               next if $tagfilter and $show_ctags and not grep { lc $_ eq lc $tagfilter } keys %{$pr->{'ctags'}};
-               next if $searchtext and not $pr->{'path'} =~ /$searchtext/
-                       and not $pr->{'descr_long'} =~ /$searchtext/;
-               # Weed out forks or non-matching entries of search
-               if ($check_forks) {
-                       my $forkbase = $project; $forkbase ||= ''; $forkbase =~ s#\.git$#/#;
-                       $forkbase="^$forkbase" if $forkbase;
-                       next if not $searchtext and not $tagfilter and $show_ctags
-                               and $pr->{'path'} =~ m#$forkbase.*/.*#; # regexp-safe
-               }
-
                if ($alternate) {
                        print "<tr class=\"dark\">\n";
                } else {
                        print "<tr class=\"light\">\n";
                }
                $alternate ^= 1;
+
                if ($check_forks) {
                        print "<td>";
                        if ($pr->{'forks'}) {
-                               print "<!-- $pr->{'forks'} -->\n";
-                               print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "+");
+                               my $nforks = scalar @{$pr->{'forks'}};
+                               if ($nforks > 0) {
+                                       print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
+                                                      -title => "$nforks forks"}, "+");
+                               } else {
+                                       print $cgi->span({-title => "$nforks forks"}, "+");
+                               }
                        }
                        print "</td>\n";
                }
@@ -5357,7 +5501,10 @@ sub git_forks {
 }
 
 sub git_project_index {
-       my @projects = git_get_projects_list($project);
+       my @projects = git_get_projects_list();
+       if (!@projects) {
+               die_error(404, "No projects found");
+       }
 
        print $cgi->header(
                -type => 'text/plain',
@@ -5399,7 +5546,11 @@ sub git_summary {
        my $check_forks = gitweb_check_feature('forks');
 
        if ($check_forks) {
+               # find forks of a project
                @forklist = git_get_projects_list($project);
+               # filter out forks of forks
+               @forklist = filter_forks_from_projects_list(\@forklist)
+                       if (@forklist);
        }
 
        git_header_html();
@@ -5428,13 +5579,14 @@ sub git_summary {
        my $show_ctags = gitweb_check_feature('ctags');
        if ($show_ctags) {
                my $ctags = git_get_project_ctags($project);
-               my $cloud = git_populate_project_tagcloud($ctags);
-               print "<tr id=\"metadata_ctags\"><td>Content tags:<br />";
-               print "</td>\n<td>" unless %$ctags;
-               print "<form action=\"$show_ctags\" method=\"post\"><input type=\"hidden\" name=\"p\" value=\"$project\" />Add: <input type=\"text\" name=\"t\" size=\"8\" /></form>";
-               print "</td>\n<td>" if %$ctags;
-               print git_show_project_tagcloud($cloud, 48);
-               print "</td></tr>";
+               if (%$ctags) {
+                       # without ability to add tags, don't show if there are none
+                       my $cloud = git_populate_project_tagcloud($ctags);
+                       print "<tr id=\"metadata_ctags\">" .
+                             "<td>content tags</td>" .
+                             "<td>".git_show_project_tagcloud($cloud, 48)."</td>" .
+                             "</tr>\n";
+               }
        }
 
        print "</table>\n";
@@ -7319,6 +7471,9 @@ sub git_atom {
 
 sub git_opml {
        my @list = git_get_projects_list();
+       if (!@list) {
+               die_error(404, "No projects found");
+       }
 
        print $cgi->header(
                -type => 'text/xml',