monolithic CGI script and into a modern Catalyst app. Fortunately this is not
as daunting as it might seem at first as gitweb.cgi follows an MVC type
structure. Once gitweb.cgi has been suitably Catalysed then it can move from
-being a "this was once gitweb.cgi" to a project of its own (hence the
+being "this was once gitweb.cgi" to a project of its own (hence the
"transitional" in the description).
As it stands Gitalist is very much in its infancy and hasn't got far
beyond a layout template and a single controller. Probably the next step is
-moving an existing action into a new Catalyst action and lay down the code
+moving an existing action into a new Catalyst action and laying down the code
to make porting further actions, or writing new ones, as simple as possible.
After that provide a model based on one of the git modules, either the Git.pm
that comes with git or Git::PurePerl, and deprecate or port the existing
-# rename this file to Gitalist.yml and put a ':' in front of 'name' if
-# you want to use YAML like in old versions of Catalyst
name Gitalist
+
+projectroot /home/dbrook/dev
+
+# show repository only if this file exists
+# (only effective if this variable evaluates to true)
+# export_ok
+
+# XXX Code in config FAIL
+# show repository only if this subroutine returns true
+# when given the path to the project, for example:
+# sub { return -e "$_[0]/git-daemon-export-ok"; }
+# export_auth_hook
+
+# home_text # html text to include at home page
+# stylesheet path/to/your/stylesheet.css
+logo /git-logo.png
+favicon /git-favicon.png
+
+# $feature{'blame'}{'default'} = [1];
+<feature>
+ <blame>
+ default = 1
+ </blame>
+</feature>
+
+# fs traversing limit for getting project list
+# the number is relative to the projectroot
+project_maxdepth 2007
-# path to git projects (<project>.git)
-$projectroot = "/home/git/repositories";
-
-# directory to use for temp files
-$git_temp = "/tmp";
-
-# target of the home link on top of all pages
-#$home_link = $my_uri || "/";
-
-# caption on top of pages
-$home_link_str = "Git Repos";
-
-# html text to include at home page
-$home_text = "indextext.html";
-
-# file with project list; by default, simply scan the projectroot dir.
-$projects_list = $projectroot;
-
-# stylesheet to use
-$stylesheet = "/gitweb.css";
-
-# logo to use
-$logo = "/git-logo.png";
-
-# the 'favicon'
-$favicon = "/git-favicon.png";
-
-$feature{'blame'}{'default'} = [1];
=cut
use IO::Capture::Stdout;
+use File::Slurp qw(slurp);
sub default :Path {
+ my ( $self, $c ) = @_;
+
+ my $capture = IO::Capture::Stdout->new();
+ $capture->start();
+ eval {
+ my $action = gitweb::main($c);
+ $action->();
+ };
+ $capture->stop();
+
+ gitweb::git_header_html();
+ gitweb::git_footer_html();
+ my $output = join '', $capture->read;
+ $c->stash->{content} = $output
+ unless $c->stash->{content};
+ $c->stash->{template} = 'default.tt2';
+}
+
+sub index :Path :Args(0) {
my ( $self, $c ) = @_;
- my $capture = IO::Capture::Stdout->new();
- $capture->start();
- eval {
- my $action = gitweb::main($c);
- $action->();
- };
- $capture->stop();
-
- gitweb::git_header_html();
- gitweb::git_footer_html();
- my $output = join '', $capture->read;
- $c->stash->{content} = $output
- unless $c->stash->{content};
- $c->stash->{template} = 'default.tt2';
+ my $order = $c->req->param('order');
+ if($order && $order !~ m/none|project|descr|owner|age/) {
+ die "Unknown order parameter";
+ }
+
+ my @list = $c->model('Git')->projects;
+ if (!@list) {
+ die "No projects found";
+ }
+
+ if (-f $c->config->{home_text}) {
+ print "<div class=\"index_include\">\n";
+ print slurp($c->config->{home_text});
+ print "</div>\n";
+ }
+
+ my $cgi;
+ print $cgi->startform(-method => "get") .
+ "<p class=\"projsearch\">Search:\n" .
+ $cgi->textfield(-name => "s", -value => $c->req->param('searchtext')) . "\n" .
+ "</p>" .
+ $cgi->end_form() . "\n";
+
+ git_project_list_body(\@list, $order);
}
=head2 end
use Moose;
use namespace::autoclean;
-use Gitalist;
+BEGIN { extends 'Catalyst::Model' }
+
use DateTime;
use Path::Class;
use Carp qw/croak/;
use List::MoreUtils qw/any/;
use Scalar::Util qw/blessed/;
-BEGIN { extends 'Catalyst::Model' }
+use Gitalist::Util qw(to_utf8);
+
+# from gitweb.pm
+use CGI::Util qw(unescape);
has git => (
is => 'ro',
return $self->run_cmd_in($project, qw/archive --format=tar/, "--prefix=${project}/", $rev);
}
+## from gitweb.pm
+
+# checking HEAD file with -e is fragile if the repository was
+# initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
+# and then pruned.
+sub check_head_link {
+ my ($dir) = @_;
+ my $headfile = "$dir/HEAD";
+ return ((-e $headfile) ||
+ (-l $headfile && readlink($headfile) =~ /^refs\/heads\//));
+}
+
+sub check_export_ok {
+ my ($dir) = @_;
+ my($export_ok, $export_auth_hook) = @{Gitalist->config}{qw(export_ok export_auth_hook)};
+ return (check_head_link($dir) &&
+ (!$export_ok || -e "$dir/$export_ok") &&
+ (!$export_auth_hook || $export_auth_hook->($dir)));
+}
+
+sub projects {
+ my($self, $filter) = @_;
+ my @list;
+
+ $filter ||= '';
+ $filter =~ s/\.git$//;
+
+ my $projects_list = Gitalist->config->{projectroot};
+ if (-d $projects_list) {
+ # search in directory
+ my $dir = $projects_list . ($filter ? "/$filter" : '');
+ # remove the trailing "/"
+ $dir =~ s!/+$!!;
+ my $pfxlen = length("$dir");
+ my $pfxdepth = ($dir =~ tr!/!!);
+
+ File::Find::find({
+ follow_fast => 1, # follow symbolic links
+ follow_skip => 2, # ignore duplicates
+ dangling_symlinks => 0, # ignore dangling symlinks, silently
+ wanted => sub {
+ # skip project-list toplevel, if we get it.
+ return if (m!^[/.]$!);
+ # only directories can be git repositories
+ return unless (-d $_);
+ # don't traverse too deep (Find is super slow on os x)
+ if (($File::Find::name =~ tr!/!!) - $pfxdepth > Gitalist->config->{project_maxdepth}) {
+ $File::Find::prune = 1;
+ return;
+ }
+
+ my $subdir = substr($File::Find::name, $pfxlen + 1);
+ # we check related file in $projectroot
+ my $path = ($filter ? "$filter/" : '') . $subdir;
+ if (check_export_ok("$projects_list/$path")) {
+ push @list, { path => $path };
+ $File::Find::prune = 1;
+ }
+ },
+ }, "$dir");
+
+ } elsif (-f $projects_list) {
+ # read from file(url-encoded):
+ # '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>) {
+ chomp $line;
+ my ($path, $owner) = split ' ', $line;
+ $path = unescape($path);
+ $owner = unescape($owner);
+ 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;
+ }
+ }
+ if (check_export_ok("$projects_list/$path")) {
+ my $pr = {
+ path => $path,
+ owner => to_utf8($owner),
+ };
+ push @list, $pr;
+ (my $forks_path = $path) =~ s/\.git$//;
+ $paths{$forks_path}++;
+ }
+ }
+ close $fd;
+ }
+ return @list;
+}
+
1;
__PACKAGE__->meta->make_immutable;
--- /dev/null
+package Gitalist::Util;
+
+use Sub::Exporter -setup => {
+ exports => ['to_utf8']
+};
+
+=pod
+
+=head1 NAME
+
+Gitalist::Util - Your usual catch all utility function package.
+
+=cut
+
+# decode sequences of octets in utf8 into Perl's internal form,
+# which is utf-8 with utf8 flag set if needed. gitweb writes out
+# in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
+sub to_utf8 {
+ my $str = shift;
+ if (utf8::valid($str)) {
+ utf8::decode($str);
+ return $str;
+ } else {
+ return decode($fallback_encoding, $str, Encode::FB_DEFAULT);
+ }
+}
+
+1;
use FindBin;
binmode STDOUT, ':utf8';
+use Gitalist::Util qw(to_utf8);
+
BEGIN {
CGI->compile();
}
use vars qw(
$cgi $version $my_url $my_uri $base_url $path_info $GIT $projectroot
$project_maxdepth $home_link $home_link_str $site_name $site_header
- $home_text $site_footer @stylesheets $stylesheet $logo $favicon
+ $home_text $site_footer @stylesheets
$logo_url $logo_label $logo_url $logo_label $projects_list
$projects_list_description_width $default_projects_order
$export_ok $export_auth_hook $strict_export @git_base_url_list
# absolute fs-path which will be prepended to the project path
our $projectroot = "/pub/scm";
- # fs traversing limit for getting project list
- # the number is relative to the projectroot
- our $project_maxdepth = 2007;
-
# target of the home link on top of all pages
our $home_link = $my_uri || "/";
# URI of stylesheets
our @stylesheets = ("gitweb.css");
- # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
- our $stylesheet = undef;
- # URI of GIT logo (72x27 size)
- our $logo = "git-logo.png";
- # URI of GIT favicon, assumed to be image/png type
- our $favicon = "git-favicon.png";
# URI and label (title) of GIT logo link
our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
our $logo_label = "git documentation";
# source of projects list
- our $projects_list = "";
+ our $projects_list = $c->config->{projectroot};
# the width (in characters) of the projects list "Description" column
our $projects_list_description_width = 25;
# version of the core git binary
our $git_version = qx("$GIT" --version) =~ m/git version (.*)$/ ? $1 : "unknown";
- $projects_list ||= $projectroot;
-
# ======================================================================
# input validation and dispatch
return $input;
}
-# decode sequences of octets in utf8 into Perl's internal form,
-# which is utf-8 with utf8 flag set if needed. gitweb writes out
-# in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
-sub to_utf8 {
- my $str = shift;
- if (utf8::valid($str)) {
- utf8::decode($str);
- return $str;
- } else {
- return decode($fallback_encoding, $str, Encode::FB_DEFAULT);
- }
-}
-
# quote unsafe chars, but keep the slash, even when it's not
# correct, but quoted slashes look too horrible in bookmarks
sub esc_param {
return wantarray ? @git_project_url_list : \@git_project_url_list;
}
-sub git_get_projects_list {
- my ($filter) = @_;
- 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" : '');
- # remove the trailing "/"
- $dir =~ s!/+$!!;
- my $pfxlen = length("$dir");
- my $pfxdepth = ($dir =~ tr!/!!);
-
- File::Find::find({
- follow_fast => 1, # follow symbolic links
- follow_skip => 2, # ignore duplicates
- dangling_symlinks => 0, # ignore dangling symlinks, silently
- wanted => sub {
- # skip project-list toplevel, if we get it.
- return if (m!^[/.]$!);
- # only directories can be git repositories
- return unless (-d $_);
- # don't traverse too deep (Find is super slow on os x)
- if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
- $File::Find::prune = 1;
- return;
- }
-
- my $subdir = 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;
- }
- },
- }, "$dir");
-
- } elsif (-f $projects_list) {
- # read from file(url-encoded):
- # '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>) {
- chomp $line;
- my ($path, $owner) = split ' ', $line;
- $path = unescape($path);
- $owner = unescape($owner);
- 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 (check_export_ok("$projectroot/$path")) {
- my $pr = {
- path => $path,
- owner => to_utf8($owner),
- };
- push @list, $pr;
- (my $forks_path = $path) =~ s/\.git$//;
- $paths{$forks_path}++;
- }
- }
- close $fd;
- }
- return @list;
-}
-
our $gitweb_project_owner = undef;
sub git_get_project_list_from_file {
# print out each stylesheet that exist, providing backwards capability
# for those people who defined $stylesheet in a config file
my $ssfmt = q[<link rel="stylesheet" type="text/css" href="%s"/>];
- $c->stash->{stylesheets} = [defined $stylesheet
- ? sprintf($ssfmt, $stylesheet)
+ $c->stash->{stylesheets} = [$c->config->{stylesheet}
+ ? sprintf($ssfmt, $c->config->{stylesheet})
: map(sprintf($ssfmt, $_), grep $_, @stylesheets)
];
$site_name, href(project=>undef, action=>"opml"));
}
+ my $favicon = $c->config->{favicon};
$c->stash->{favicon} = defined $favicon
? qq(<link rel="shortcut icon" href="$favicon" type="image/png" />)
: '';
? insert_file($site_header)
: '';
+ my $logo = $c->config->{logo};
$c->stash->{logo}
= $cgi->a({-href => esc_url($logo_url),
-title => $logo_label},
"<language>en</language>\n" .
# project owner is responsible for 'editorial' content
"<managingEditor>$owner</managingEditor>\n";
- if (defined $logo || defined $favicon) {
+ if ($c->config->{logo} || $c->config->{favicon}) {
# prefer the logo to the favicon, since RSS
# doesn't allow both
- my $img = esc_url($logo || $favicon);
+ my $img = esc_url($c->config->{logo} || $c->config->{favicon});
print "<image>\n" .
"<url>$img</url>\n" .
"<title>$title</title>\n" .
"<id>" . href(-full=>1) . "</id>\n" .
# use project owner for feed author
"<author><name>$owner</name></author>\n";
- if (defined $favicon) {
- print "<icon>" . esc_url($favicon) . "</icon>\n";
+ if ($c->config->{favicon}) {
+ print "<icon>" . esc_url($c->config->{favicon}) . "</icon>\n";
}
if (defined $logo_url) {
# not twice as wide as tall: 72 x 27 pixels
- print "<logo>" . esc_url($logo) . "</logo>\n";
+ print "<logo>" . esc_url($c->config->{logo}) . "</logo>\n";
}
if (! %latest_date) {
# dummy date to keep the feed valid until commits trickle in:
IF page_nav;
INCLUDE "page_nav.tt2";
END;
+
+ IF action;
+ INCLUDE "$action.tt2";
+ ELSE;
+ # The output of gitweb.cgi is injected at this point.
+ content;
+ END;
%]
-[%
-# The output of gitweb.cgi is injected at this point.
-content %]
[%- # git_footer_html
-%]
projects / catagits/Gitalist.git / commitdiff