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;

my $debug = 0;

my $max_items = 500;

my $repository_dir = '/srv/svn';
my $svnweb = 'https://svn-strix.carnet.hr/private/svnweb/index.cgi/%s/revision?rev=%d';
my $strip_branch = s!^/(branches/)?[^/]+/!/!;

# my local config for development
$repository_dir = '/home/dpavlin/private/svn';
$svnweb = 'http://localhost/svnweb/index.cgi/%s/revision?rev=%d';
$strip_branch = s!!!;

# 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];

sub select_repository {
        $q->start_form( -name => 'current_repository', -id => 'current_repository' ),
        "Select repository: ",
        $q->popup_menu( -name => 'repository', -values => [ @repositories ], -onChange => qq{document.getElementById('current_repository').submit();} ),
        $q->submit,
        $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="?repository=$repository&json=1" />

<script
        src="http://static.simile.mit.edu/exhibit/api-2.0/exhibit-api.js"
        type="text/javascript"></script>

<script
        src="http://static.simile.mit.edu/exhibit/extensions-2.0/time/time-extension.js"></script>

</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>
    
            <div ex:role="facet" ex:expression=".action" ex:facetLabel="Action"
                ex:sortMode="count" ex:scroll="false"></div>
                
            <div ex:role="facet" ex:expression=".revision" ex:facetClass="NumericRange"
                ex:interval="10" ex:scroll="true"></div>
                
            <div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Count"
                ex:sortMode="count"></div>
                
        </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="650" />
            
            <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;
{
        open( my $log_fh, '-|', "svn log --xml --stop-on-copy -v file://$repository_dir/$repository" ) || 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;

                $max_items--;
                # we skip all other items in commits with more than 10 files as they are too chatty
                last if $#{ $e->{'paths'}->{'path'} } > 10;
#               last; # FIXME record just single item for each commit!
                # we also break out when $max_items is reached to keep browser (somewhat) alive
                last if ! $max_items;
        }

        last if ! $max_items;
}

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	14
13			my $debug = 0;
14
15			my $max_items = 500;
16
17	dpavlin	16	my $repository_dir = '/srv/svn';
18			my $svnweb = 'https://svn-strix.carnet.hr/private/svnweb/index.cgi/%s/revision?rev=%d';
19			my $strip_branch = s!^/(branches/)?[^/]+/!/!;
20	dpavlin	14
21	dpavlin	16	# my local config for development
22			$repository_dir = '/home/dpavlin/private/svn';
23			$svnweb = 'http://localhost/svnweb/index.cgi/%s/revision?rev=%d';
24			$strip_branch = s!!!;
25
26	dpavlin	15	# for older JSON
27	dpavlin	16	#sub encode_json { objToJson( @_ ) }
28	dpavlin	15
29			sub path_strip {
30			my $path = shift;
31	dpavlin	16	$path =~ $strip_branch;
32	dpavlin	15	return $path;
33			}
34
35	dpavlin	16	opendir(my $dir, $repository_dir) \|\| die "can't open $repository_dir: $!";
36			my @repositories = sort grep { -f "$repository_dir/$_/format" } readdir($dir);
37			closedir($dir);
38
39			our $q = CGI->new;
40			my $repository = $q->param('repository');
41			$repository = (grep { m/^\Q$repository\E$/ } @repositories )[0];
42
43			sub select_repository {
44			$q->start_form( -name => 'current_repository', -id => 'current_repository' ),
45			"Select repository: ",
46			$q->popup_menu( -name => 'repository', -values => [ @repositories ], -onChange => qq{document.getElementById('current_repository').submit();} ),
47			$q->submit,
48			$q->end_form;
49			}
50
51			if ( ! $repository ) {
52			print $q->header,$q->start_html("Select repository"), select_repository;
53			exit;
54			} elsif ( ! $q->param('json') ) {
55			$repository \|\|= 'Select repository';
56			print $q->header, qq\|
57			<html>
58			<head>
59			<title>$repository -- Exhibit SVN exhibit facet browsing</title>
60
61			<link rel="exhibit/data"
62			type="application/json"
63			href="?repository=$repository&json=1" />
64
65			<script
66			src="http://static.simile.mit.edu/exhibit/api-2.0/exhibit-api.js"
67			type="text/javascript"></script>
68
69			<script
70			src="http://static.simile.mit.edu/exhibit/extensions-2.0/time/time-extension.js"></script>
71
72			</head>
73			<body>
74			<div style="float: right">
75			<a href="http://stud05.technikum-wien.at/~tw05n126/exhibit/log/log.html">based on</a>,
76			<a href="http://simile.mit.edu/exhibit/">exhibit</a></div>
77			\|, select_repository, qq\|
78			<table width="100%" style="font-size: 0.8em">
79			<tr valign="top">
80			<td rowspan="2" width="25%">
81			<div ex:role="facet" ex:facetClass="TextSearch" ex:facetLabel="Search"></div>
82
83			<div ex:role="facet" ex:expression=".author" ex:facetLabel="Author"
84			ex:sortMode="count"></div>
85
86			<div ex:role="facet" ex:expression=".action" ex:facetLabel="Action"
87			ex:sortMode="count" ex:scroll="false"></div>
88
89			<div ex:role="facet" ex:expression=".revision" ex:facetClass="NumericRange"
90			ex:interval="10" ex:scroll="true"></div>
91
92			<div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Count"
93			ex:sortMode="count"></div>
94
95			</td>
96			<td>
97
98			<div ex:role="facet" ex:expression=".path" ex:facetLabel="Path by Name"
99			ex:sortMode="value"></div>
100			</td>
101			</tr>
102			<tr valign="top">
103			<td ex:role="viewPanel">
104
105			<div ex:role="view" ex:viewClass="Timeline" ex:start=".date"
106			ex:colorKey=".author"
107			ex:topBandUnit="week" ex:topBandPixelsPerUnit="200"
108			ex:bottomBandUnit="month" ex:bottomBandPixelsPerUnit="25"
109			ex:timelineHeight="650" />
110
111			<div ex:role="view" ex:viewClass="Tabular"
112			ex:columns=".revision, .author, .date, .path, .action, .copyfrom-path, .copyfrom-rev, .msg"
113			/>
114			</td>
115
116			</tr>
117			</table>
118
119			</body>
120			</html>
121			\|;
122			exit;
123			}
124
125	dpavlin	14	my $json = {
126			properties => {
127			revision => {
128			valueType => "number",
129			},
130			'google-code-svn-link' => {
131			valueType => "url"
132			}
133			},
134			items => [],
135			};
136
137			my $log;
138			{
139	dpavlin	16	open( my $log_fh, '-\|', "svn log --xml --stop-on-copy -v file://$repository_dir/$repository" ) \|\| die "can't read svn log: $!";
140	dpavlin	14	local $/ = undef;
141			$log = <$log_fh>;
142			close( $log_fh );
143			}
144
145			my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);
146
147			warn dump( $xml ) if $debug;
148
149			foreach my $e (@{$xml->{'logentry'}}) {
150
151			foreach my $p (@{$e->{'paths'}->{'path'}}) {
152	dpavlin	15	my $path = delete( $p->{'content'} );
153			my $label = $e->{'revision'} . ' - ' . path_strip( $path );
154	dpavlin	14	my $item = {
155			type => 'Item',
156			id => $label,
157			label => $label,
158	dpavlin	16	uri => sprintf($svnweb, $repository, $e->{'revision'}),
159	dpavlin	15	path_full => $path,
160			path => path_strip( $path ),
161	dpavlin	14	};
162
163	dpavlin	15	$item->{$_} = $p->{$_} foreach grep { ! defined $item->{$_} } keys %$p;
164			$item->{$_} = $e->{$_} foreach grep { ! defined $item->{$_} && ! /^(paths)$/ } keys %$e;
165	dpavlin	14
166			warn dump( $item ) if $debug;
167
168			push @{ $json->{items} }, $item;
169
170			$max_items--;
171			# we skip all other items in commits with more than 10 files as they are too chatty
172			last if $#{ $e->{'paths'}->{'path'} } > 10;
173			# last; # FIXME record just single item for each commit!
174			# we also break out when $max_items is reached to keep browser (somewhat) alive
175			last if ! $max_items;
176			}
177
178			last if ! $max_items;
179			}
180
181			print qq\|Content-type: application/json\n\r\n\r\|, encode_json( $json );
182