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	#!/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	use CGI;
12	use File::Slurp;
13
14	my $debug = $ENV{'DEBUG'} \|\| 0;
15
16	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	die "no js URLs to Exhibit API and/or plugins" unless $config->{js};
22
23	my $limit = 1000;
24
25	# for older JSON
26	#sub encode_json { objToJson( @_ ) }
27
28	sub path_strip {
29	my $path = shift;
30	# $path =~ $strip_branch;
31	return $path;
32	}
33
34	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	$repository = (grep { m/^\Q$repository\E$/ } @repositories )[0] if $repository;
41
42	warn "q = ",dump( $q );
43	warn "# limit: ", $q->param('limit');
44
45	sub select_repository {
46	my $onChange = qq{document.getElementById('current_repository').submit();};
47	# 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	return (
50	$q->start_form( -name => 'current_repository', -id => 'current_repository', -method => 'post' ),
51	"From repository ",
52	$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	" show ",
56	$q->popup_menu( -name => 'limit', -values => [ qw/100 500 1000 5000 10000/ ], -onChange => $onChange ),
57	" revisions and ",
58	$q->checkbox(-name=>'path', -checked=>1, -value=>'ON', -label=>'path modifications', -onChange => $onChange ),
59	" ",
60	$q->submit(-name=>'did_submit', -value=>'in Exhibit'),
61	$q->end_form
62	);
63	}
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	href="\|, $q->url( -query => 1 ), qq\|&json=1" />
78
79	\|, join("\n", map { qq\|<script src="$_" type="text/javascript"></script>\| } @{ $config->{js} } ), qq\|
80
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	\|, $q->param('path') ?
95	qq\|
96	<div ex:role="facet" ex:expression=".action" ex:facetLabel="Action"
97	ex:sortMode="count" ex:scroll="false"></div>
98	\| : '',
99	qq\|
100	<div ex:role="facet" ex:expression=".revision" ex:facetClass="NumericRange"
101	ex:interval="20" ex:scroll="true"></div>
102	\|, $q->param('path') ?
103	qq\|
104	<div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Count"
105	ex:sortMode="count"></div>
106	\| : '',
107	qq\|
108	</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	ex:timelineHeight="550" />
123
124	<div ex:role="view" ex:viewClass="Tabular"
125	ex:columns=".revision, .author, .date, .PATH, .action, .copyfrom-path, .copyfrom-rev, .msg"
126	/>
127	</td>
128
129	</tr>
130	</table>
131
132	</body>
133	</html>
134	\|;
135	exit;
136	}
137
138	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	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	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	my $path = delete( $p->{'content'} );
168	my $label = $e->{'revision'} . ' - ' . path_strip( $path );
169	my $item = {
170	type => 'Item',
171	id => $label,
172	label => $label,
173	uri => sprintf($svnweb, $repository, $e->{'revision'}),
174	path_full => $path,
175	path => path_strip( $path ),
176	};
177
178	$item->{$_} = $p->{$_} foreach grep { ! defined $item->{$_} } keys %$p;
179	$item->{$_} = $e->{$_} foreach grep { ! defined $item->{$_} && ! /^(paths)$/ } keys %$e;
180
181	warn dump( $item ) if $debug;
182
183	push @{ $json->{items} }, $item;
184
185	last if ! $q->param('path');
186	}
187
188	}
189
190	print qq\|Content-type: application/json\n\r\n\r\|, encode_json( $json );
191