simile/svn/index.cgi

#!/usr/bin/perl -w

# svn2js.pl
#
# 10/05/08 16:15:38 CEST Dobrica Pavlinusic <dpavlin@rot13.org>

use strict;
use XML::Simple;
use Data::Dump qw/dump/;
use JSON;
use CGI;
use File::Slurp;

my $debug = $ENV{'DEBUG'} || 0;

my $config_path = $0;
$config_path =~ s/.cgi/.js/;
my $config = from_json( read_file( $config_path ) );
my $repository_dir = $config->{repository_dir} || die "no repository_dir in $config_path";
my $svnweb = $config->{svnweb} || die "no svnweb in $config_path";
die "no js URLs to Exhibit API and/or plugins" unless $config->{js};

my $limit = 1000;

# for older JSON
#sub encode_json { objToJson( @_ ) }

sub path_strip {
        my $path = shift;
#       $path =~ $strip_branch;
        return $path;
}

opendir(my $dir, $repository_dir) || die "can't open $repository_dir: $!";
my @repositories = sort grep { -f "$repository_dir/$_/format" } readdir($dir);
closedir($dir);

our $q = CGI->new;
my $repository = $q->param('repository');
$repository = (grep { m/^\Q$repository\E$/ } @repositories )[0] if $repository;

warn "q = ",dump( $q );
warn "# limit: ", $q->param('limit');

sub select_repository {
        my $onChange = qq{document.getElementById('current_repository').submit();};
        # we want to activete javascript magic refresh after we hit submit for the first time, and not always
        $onChange = '' unless $q->param('did_submit');
        return (
                $q->start_form( -name => 'current_repository', -id => 'current_repository', -method => 'post' ),
                "From repository ",
                $q->param('did_submit') ?
                        $q->popup_menu( -name => 'repository', -values => [ @repositories ], -onChange => $onChange ) :
                        $q->radio_group( -name => 'repository', -values => [ @repositories ], -onChange => $onChange ), # , -linebreak => 'true' ),
                " show ",
                $q->popup_menu( -name => 'limit', -values => [ qw/100 500 1000 5000 10000/ ], -onChange => $onChange ),
                " revisions and ",
                $q->checkbox(-name=>'path', -checked=>1, -value=>'ON', -label=>'path modifications', -onChange => $onChange ),
                " ",
                $q->submit(-name=>'did_submit', -value=>'in Exhibit'),
                $q->end_form
        );
}

if ( ! $repository ) {
        print $q->header,$q->start_html("Select repository"), select_repository;
        exit;
} elsif ( ! $q->param('json') ) {
        $repository ||= 'Select repository';
        print $q->header, qq|
<html>
<head>
<title>$repository -- Exhibit SVN exhibit facet browsing</title>

           <link rel="exhibit/data"
    type="application/json" 
    href="|, $q->url( -query => 1 ), qq|&json=1" />

|, join("\n", map { qq|<script src="$_" type="text/javascript"></script>| } @{ $config->{js} } ), qq|

</head>
<body>
<div style="float: right">
<a href="http://stud05.technikum-wien.at/~tw05n126/exhibit/log/log.html">based on</a>,
<a href="http://simile.mit.edu/exhibit/">exhibit</a></div>
|, select_repository, qq|
<table width="100%" style="font-size: 0.8em">
    <tr valign="top">
        <td rowspan="2" width="25%">
          <div ex:role="facet" ex:facetClass="TextSearch" ex:facetLabel="Search"></div>
        
            <div ex:role="facet" ex:expression=".author" ex:facetLabel="Author"
                ex:sortMode="count"></div>
|, $q->param('path') ?
qq|
            <div ex:role="facet" ex:expression=".action" ex:facetLabel="Action"
                ex:sortMode="count" ex:scroll="false"></div>
| : '',
qq|
            <div ex:role="facet" ex:expression=".revision" ex:facetClass="NumericRange"
                ex:interval="20" ex:scroll="true"></div>
|, $q->param('path') ?
qq|
            <div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Count"
                ex:sortMode="count"></div>
| : '',
qq|
        </td>
        <td>
        
            <div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Name"
                ex:sortMode="value"></div>
        </td>
    </tr>
    <tr valign="top">
        <td ex:role="viewPanel">

            <div ex:role="view" ex:viewClass="Timeline" ex:start=".date"
                ex:colorKey=".author" 
                ex:topBandUnit="week" ex:topBandPixelsPerUnit="200"
                ex:bottomBandUnit="month" ex:bottomBandPixelsPerUnit="25"
                ex:timelineHeight="550" />
            
            <div ex:role="view" ex:viewClass="Tabular"
                ex:columns=".revision, .author, .date, .PATH, .action, .copyfrom-path, .copyfrom-rev, .msg" 
                />
        </td>

    </tr>
</table>

</body>
</html>
        |;
        exit;
}

my $json = {
        properties => {
                revision => {
                        valueType => "number",
                },
                'google-code-svn-link' => {
                        valueType => "url"
                }
        },
        items => [],
};

my $log;
{
        my $cmd = "svn log --xml --stop-on-copy -v --limit " . ( $q->param('limit') || $limit ) . " file://$repository_dir/$repository";
        warn "cmd: $cmd\n";
        open( my $log_fh, '-|', $cmd) || die "can't read svn log: $!";
        local $/ = undef;
        $log = <$log_fh>;
        close( $log_fh );
}

my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);

warn dump( $xml ) if $debug;

foreach my $e (@{$xml->{'logentry'}}) {

        foreach my $p (@{$e->{'paths'}->{'path'}}) {
                my $path = delete( $p->{'content'} );
                my $label = $e->{'revision'} . ' - ' . path_strip( $path );
                my $item = {
                        type => 'Item',
                        id => $label,
                        label => $label,
                        uri => sprintf($svnweb, $repository, $e->{'revision'}),
                        path_full => $path,
                        path => path_strip( $path ),
                };

                $item->{$_} = $p->{$_} foreach grep { ! defined $item->{$_} } keys %$p;
                $item->{$_} = $e->{$_} foreach grep { ! defined $item->{$_} && ! /^(paths)$/ } keys %$e;

                warn dump( $item ) if $debug;

                push @{ $json->{items} }, $item;

                last if ! $q->param('path');
        }

}

print qq|Content-type: application/json\n\r\n\r|, encode_json( $json );

1	dpavlin	14	#!/usr/bin/perl -w
2
3			# svn2js.pl
4			#
5			# 10/05/08 16:15:38 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6
7			use strict;
8			use XML::Simple;
9			use Data::Dump qw/dump/;
10			use JSON;
11	dpavlin	16	use CGI;
12	dpavlin	36	use File::Slurp;
13	dpavlin	14
14	dpavlin	17	my $debug = $ENV{'DEBUG'} \|\| 0;
15	dpavlin	14
16	dpavlin	36	my $config_path = $0;
17			$config_path =~ s/.cgi/.js/;
18			my $config = from_json( read_file( $config_path ) );
19			my $repository_dir = $config->{repository_dir} \|\| die "no repository_dir in $config_path";
20			my $svnweb = $config->{svnweb} \|\| die "no svnweb in $config_path";
21	dpavlin	44	die "no js URLs to Exhibit API and/or plugins" unless $config->{js};
22	dpavlin	36
23	dpavlin	30	my $limit = 1000;
24	dpavlin	14
25	dpavlin	15	# for older JSON
26	dpavlin	16	#sub encode_json { objToJson( @_ ) }
27	dpavlin	15
28			sub path_strip {
29			my $path = shift;
30	dpavlin	30	# $path =~ $strip_branch;
31	dpavlin	15	return $path;
32			}
33
34	dpavlin	16	opendir(my $dir, $repository_dir) \|\| die "can't open $repository_dir: $!";
35			my @repositories = sort grep { -f "$repository_dir/$_/format" } readdir($dir);
36			closedir($dir);
37
38			our $q = CGI->new;
39			my $repository = $q->param('repository');
40	dpavlin	30	$repository = (grep { m/^\Q$repository\E$/ } @repositories )[0] if $repository;
41	dpavlin	16
42	dpavlin	30	warn "q = ",dump( $q );
43			warn "# limit: ", $q->param('limit');
44
45	dpavlin	16	sub select_repository {
46	dpavlin	30	my $onChange = qq{document.getElementById('current_repository').submit();};
47	dpavlin	43	# we want to activete javascript magic refresh after we hit submit for the first time, and not always
48			$onChange = '' unless $q->param('did_submit');
49	dpavlin	30	return (
50			$q->start_form( -name => 'current_repository', -id => 'current_repository', -method => 'post' ),
51			"From repository ",
52	dpavlin	46	$q->param('did_submit') ?
53			$q->popup_menu( -name => 'repository', -values => [ @repositories ], -onChange => $onChange ) :
54			$q->radio_group( -name => 'repository', -values => [ @repositories ], -onChange => $onChange ), # , -linebreak => 'true' ),
55	dpavlin	30	" show ",
56			$q->popup_menu( -name => 'limit', -values => [ qw/100 500 1000 5000 10000/ ], -onChange => $onChange ),
57	dpavlin	43	" revisions and ",
58	dpavlin	30	$q->checkbox(-name=>'path', -checked=>1, -value=>'ON', -label=>'path modifications', -onChange => $onChange ),
59	dpavlin	43	" ",
60			$q->submit(-name=>'did_submit', -value=>'in Exhibit'),
61	dpavlin	30	$q->end_form
62			);
63	dpavlin	16	}
64
65			if ( ! $repository ) {
66			print $q->header,$q->start_html("Select repository"), select_repository;
67			exit;
68			} elsif ( ! $q->param('json') ) {
69			$repository \|\|= 'Select repository';
70			print $q->header, qq\|
71			<html>
72			<head>
73			<title>$repository -- Exhibit SVN exhibit facet browsing</title>
74
75			<link rel="exhibit/data"
76			type="application/json"
77	dpavlin	30	href="\|, $q->url( -query => 1 ), qq\|&json=1" />
78	dpavlin	16
79	dpavlin	44	\|, join("\n", map { qq\|<script src="$_" type="text/javascript"></script>\| } @{ $config->{js} } ), qq\|
80	dpavlin	16
81			</head>
82			<body>
83			<div style="float: right">
84			<a href="http://stud05.technikum-wien.at/~tw05n126/exhibit/log/log.html">based on</a>,
85			<a href="http://simile.mit.edu/exhibit/">exhibit</a></div>
86			\|, select_repository, qq\|
87			<table width="100%" style="font-size: 0.8em">
88			<tr valign="top">
89			<td rowspan="2" width="25%">
90			<div ex:role="facet" ex:facetClass="TextSearch" ex:facetLabel="Search"></div>
91
92			<div ex:role="facet" ex:expression=".author" ex:facetLabel="Author"
93			ex:sortMode="count"></div>
94	dpavlin	30	\|, $q->param('path') ?
95			qq\|
96	dpavlin	16	<div ex:role="facet" ex:expression=".action" ex:facetLabel="Action"
97			ex:sortMode="count" ex:scroll="false"></div>
98	dpavlin	30	\| : '',
99			qq\|
100	dpavlin	16	<div ex:role="facet" ex:expression=".revision" ex:facetClass="NumericRange"
101	dpavlin	30	ex:interval="20" ex:scroll="true"></div>
102			\|, $q->param('path') ?
103			qq\|
104	dpavlin	16	<div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Count"
105			ex:sortMode="count"></div>
106	dpavlin	30	\| : '',
107			qq\|
108	dpavlin	16	</td>
109			<td>
110
111			<div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Name"
112			ex:sortMode="value"></div>
113			</td>
114			</tr>
115			<tr valign="top">
116			<td ex:role="viewPanel">
117
118			<div ex:role="view" ex:viewClass="Timeline" ex:start=".date"
119			ex:colorKey=".author"
120			ex:topBandUnit="week" ex:topBandPixelsPerUnit="200"
121			ex:bottomBandUnit="month" ex:bottomBandPixelsPerUnit="25"
122	dpavlin	30	ex:timelineHeight="550" />
123	dpavlin	16
124			<div ex:role="view" ex:viewClass="Tabular"
125	dpavlin	30	ex:columns=".revision, .author, .date, .PATH, .action, .copyfrom-path, .copyfrom-rev, .msg"
126	dpavlin	16	/>
127			</td>
128
129			</tr>
130			</table>
131
132			</body>
133			</html>
134			\|;
135			exit;
136			}
137
138	dpavlin	14	my $json = {
139			properties => {
140			revision => {
141			valueType => "number",
142			},
143			'google-code-svn-link' => {
144			valueType => "url"
145			}
146			},
147			items => [],
148			};
149
150			my $log;
151			{
152	dpavlin	30	my $cmd = "svn log --xml --stop-on-copy -v --limit " . ( $q->param('limit') \|\| $limit ) . " file://$repository_dir/$repository";
153			warn "cmd: $cmd\n";
154			open( my $log_fh, '-\|', $cmd) \|\| die "can't read svn log: $!";
155	dpavlin	14	local $/ = undef;
156			$log = <$log_fh>;
157			close( $log_fh );
158			}
159
160			my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);
161
162			warn dump( $xml ) if $debug;
163
164			foreach my $e (@{$xml->{'logentry'}}) {
165
166			foreach my $p (@{$e->{'paths'}->{'path'}}) {
167	dpavlin	15	my $path = delete( $p->{'content'} );
168			my $label = $e->{'revision'} . ' - ' . path_strip( $path );
169	dpavlin	14	my $item = {
170			type => 'Item',
171			id => $label,
172			label => $label,
173	dpavlin	16	uri => sprintf($svnweb, $repository, $e->{'revision'}),
174	dpavlin	15	path_full => $path,
175			path => path_strip( $path ),
176	dpavlin	14	};
177
178	dpavlin	15	$item->{$_} = $p->{$_} foreach grep { ! defined $item->{$_} } keys %$p;
179			$item->{$_} = $e->{$_} foreach grep { ! defined $item->{$_} && ! /^(paths)$/ } keys %$e;
180	dpavlin	14
181			warn dump( $item ) if $debug;
182
183			push @{ $json->{items} }, $item;
184
185	dpavlin	30	last if ! $q->param('path');
186	dpavlin	14	}
187
188			}
189
190			print qq\|Content-type: application/json\n\r\n\r\|, encode_json( $json );
191