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->popup_menu( -name => 'repository', -values => [ @repositories ], -onChange => $onChange ),
                " 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			$q->popup_menu( -name => 'repository', -values => [ @repositories ], -onChange => $onChange ),
53			" show ",
54			$q->popup_menu( -name => 'limit', -values => [ qw/100 500 1000 5000 10000/ ], -onChange => $onChange ),
55	dpavlin	43	" revisions and ",
56	dpavlin	30	$q->checkbox(-name=>'path', -checked=>1, -value=>'ON', -label=>'path modifications', -onChange => $onChange ),
57	dpavlin	43	" ",
58			$q->submit(-name=>'did_submit', -value=>'in Exhibit'),
59	dpavlin	30	$q->end_form
60			);
61	dpavlin	16	}
62
63			if ( ! $repository ) {
64			print $q->header,$q->start_html("Select repository"), select_repository;
65			exit;
66			} elsif ( ! $q->param('json') ) {
67			$repository \|\|= 'Select repository';
68			print $q->header, qq\|
69			<html>
70			<head>
71			<title>$repository -- Exhibit SVN exhibit facet browsing</title>
72
73			<link rel="exhibit/data"
74			type="application/json"
75	dpavlin	30	href="\|, $q->url( -query => 1 ), qq\|&json=1" />
76	dpavlin	16
77	dpavlin	44	\|, join("\n", map { qq\|<script src="$_" type="text/javascript"></script>\| } @{ $config->{js} } ), qq\|
78	dpavlin	16
79			</head>
80			<body>
81			<div style="float: right">
82			<a href="http://stud05.technikum-wien.at/~tw05n126/exhibit/log/log.html">based on</a>,
83			<a href="http://simile.mit.edu/exhibit/">exhibit</a></div>
84			\|, select_repository, qq\|
85			<table width="100%" style="font-size: 0.8em">
86			<tr valign="top">
87			<td rowspan="2" width="25%">
88			<div ex:role="facet" ex:facetClass="TextSearch" ex:facetLabel="Search"></div>
89
90			<div ex:role="facet" ex:expression=".author" ex:facetLabel="Author"
91			ex:sortMode="count"></div>
92	dpavlin	30	\|, $q->param('path') ?
93			qq\|
94	dpavlin	16	<div ex:role="facet" ex:expression=".action" ex:facetLabel="Action"
95			ex:sortMode="count" ex:scroll="false"></div>
96	dpavlin	30	\| : '',
97			qq\|
98	dpavlin	16	<div ex:role="facet" ex:expression=".revision" ex:facetClass="NumericRange"
99	dpavlin	30	ex:interval="20" ex:scroll="true"></div>
100			\|, $q->param('path') ?
101			qq\|
102	dpavlin	16	<div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Count"
103			ex:sortMode="count"></div>
104	dpavlin	30	\| : '',
105			qq\|
106	dpavlin	16	</td>
107			<td>
108
109			<div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Name"
110			ex:sortMode="value"></div>
111			</td>
112			</tr>
113			<tr valign="top">
114			<td ex:role="viewPanel">
115
116			<div ex:role="view" ex:viewClass="Timeline" ex:start=".date"
117			ex:colorKey=".author"
118			ex:topBandUnit="week" ex:topBandPixelsPerUnit="200"
119			ex:bottomBandUnit="month" ex:bottomBandPixelsPerUnit="25"
120	dpavlin	30	ex:timelineHeight="550" />
121	dpavlin	16
122			<div ex:role="view" ex:viewClass="Tabular"
123	dpavlin	30	ex:columns=".revision, .author, .date, .PATH, .action, .copyfrom-path, .copyfrom-rev, .msg"
124	dpavlin	16	/>
125			</td>
126
127			</tr>
128			</table>
129
130			</body>
131			</html>
132			\|;
133			exit;
134			}
135
136	dpavlin	14	my $json = {
137			properties => {
138			revision => {
139			valueType => "number",
140			},
141			'google-code-svn-link' => {
142			valueType => "url"
143			}
144			},
145			items => [],
146			};
147
148			my $log;
149			{
150	dpavlin	30	my $cmd = "svn log --xml --stop-on-copy -v --limit " . ( $q->param('limit') \|\| $limit ) . " file://$repository_dir/$repository";
151			warn "cmd: $cmd\n";
152			open( my $log_fh, '-\|', $cmd) \|\| die "can't read svn log: $!";
153	dpavlin	14	local $/ = undef;
154			$log = <$log_fh>;
155			close( $log_fh );
156			}
157
158			my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);
159
160			warn dump( $xml ) if $debug;
161
162			foreach my $e (@{$xml->{'logentry'}}) {
163
164			foreach my $p (@{$e->{'paths'}->{'path'}}) {
165	dpavlin	15	my $path = delete( $p->{'content'} );
166			my $label = $e->{'revision'} . ' - ' . path_strip( $path );
167	dpavlin	14	my $item = {
168			type => 'Item',
169			id => $label,
170			label => $label,
171	dpavlin	16	uri => sprintf($svnweb, $repository, $e->{'revision'}),
172	dpavlin	15	path_full => $path,
173			path => path_strip( $path ),
174	dpavlin	14	};
175
176	dpavlin	15	$item->{$_} = $p->{$_} foreach grep { ! defined $item->{$_} } keys %$p;
177			$item->{$_} = $e->{$_} foreach grep { ! defined $item->{$_} && ! /^(paths)$/ } keys %$e;
178	dpavlin	14
179			warn dump( $item ) if $debug;
180
181			push @{ $json->{items} }, $item;
182
183	dpavlin	30	last if ! $q->param('path');
184	dpavlin	14	}
185
186			}
187
188			print qq\|Content-type: application/json\n\r\n\r\|, encode_json( $json );
189