# Code for automatic SVN public logging

This was SVN commit r3730.

source/tools/autolog/SVNLog/Makefile.PL

@@ -0,0 +1,17 @@
+use inc::Module::Install;
+
+name('SVNLog');
+abstract('Catalyst Application');
+author('Catalyst developer');
+version_from('lib/SVNLog.pm');
+license('perl');
+
+include('ExtUtils::AutoInstall');
+
+requires( Catalyst => '5.60' );
+
+catalyst_files();
+
+install_script( glob('script/*.pl') );
+auto_install();
+&WriteAll;

source/tools/autolog/SVNLog/config.yml

@@ -0,0 +1,10 @@
+name: SVNLog
+svn:
+  username: philip
+  password: ????????
+  url     : http://artificetech.co.uk/svn/trunk
+cdbi:
+  dsn     : dbi:SQLite:/var/www/svnlog/SVNLog/sql/svnlog.db
+scp:
+  command : /usr/bin/scp -i /var/www/svnlog/ssh/wfgkey
+  filename: philip@wildfiregames.com:~/svnlog/public

source/tools/autolog/SVNLog/lib/SVNLog.pm

@@ -0,0 +1,22 @@
+package SVNLog;
+
+use strict;
+use warnings;
+
+use YAML ();
+
+use Catalyst qw/FormValidator CDBI::Transaction/;
+
+our $VERSION = '0.01';
+
+__PACKAGE__->config(YAML::LoadFile(__PACKAGE__->path_to('config.yml')));
+
+__PACKAGE__->setup;
+
+sub end : Private {
+    my ($self, $c) = @_;
+
+    $c->forward('SVNLog::View::TT') unless $c->response->body;
+}
+
+1;

source/tools/autolog/SVNLog/lib/SVNLog/Controller/LogUpdate.pm

@@ -0,0 +1,135 @@
+package SVNLog::Controller::LogUpdate;
+
+use strict;
+use base 'Catalyst::Controller';
+
+use XML::Simple;
+use Text::ASCIITable::Wrap;
+use File::Remote;
+
+sub doupdate : Local
+{
+	my ($self, $c) = @_;
+	
+	my $latest = SVNLog::Model::CDBI::Logentry->maximum_value_of('revision') || 0;
+	my $min = $latest;
+	my $max = 'HEAD';
+	
+	my $svn_cmd_data = '--username '.$c->config->{svn}{username}.' --password '.$c->config->{svn}{password}.' '.$c->config->{svn}{url};
+	my $log_xml = `svn log --xml --verbose -r $min:$max $svn_cmd_data`;
+	die "SVN request failed" if not (defined $log_xml and $log_xml =~ m~</log>~);
+	
+	my $log = XMLin($log_xml, ContentKey => 'path');
+
+	my $max_seen = -1;
+	
+	$c->transaction(sub {
+		for my $logentry (ref $log->{logentry} eq 'ARRAY' ? @{$log->{logentry}} : ($log->{logentry}))
+		{
+			$max_seen = $logentry->{revision} if $logentry->{revision} > $max_seen;
+			next if $logentry->{revision} <= $latest;
+
+			my $paths = $logentry->{paths}->{path};
+			delete $logentry->{paths};
+			
+			# Convert <msg></msg> into just a string (because XML::Simple doesn't know that's what it should be)
+			$logentry->{msg} = '' if ref $logentry->{msg};
+			
+			my $entry = SVNLog::Model::CDBI::Logentry->insert($logentry);
+
+			for my $path (ref $paths eq 'ARRAY' ? @$paths : ($paths))
+			{
+				SVNLog::Model::CDBI::Paths->insert({logentry => $entry->id, filter_copyfrom(%$path)});
+			}
+		}
+	}) or $c->log->error("Transaction failed: " . $c->error->[-1]);
+	
+	add_default_public_msgs($c);
+
+	my $scp = new File::Remote(rcp => $c->config->{scp}{command});
+	$scp->writefile($c->config->{scp}{filename}, generate_text()) or die $!;
+
+	$c->res->body("Updated log to $max_seen.");
+}
+
+sub defaultise : Local
+{
+	my ($self, $c) = @_;
+	add_default_public_msgs($c);
+	$c->res->body("Done");
+}
+
+# (To reset the database:
+#  delete from public_message; delete from sqlite_sequence where name = "public_message";
+# )
+
+sub add_default_public_msgs
+{
+	my ($c) = @_;
+	
+	$c->transaction(sub {
+		my @unmessaged = SVNLog::Model::CDBI::Logentry->retrieve_from_sql(qq{
+			NOT (SELECT COUNT(*) FROM public_message WHERE public_message.logentry = logentry.id)
+			ORDER BY logentry.id
+		});
+		for my $logentry (@unmessaged)
+		{
+			my @lines;
+			for (split /\n/, $logentry->msg)
+			{
+				push @lines, $_ if s/^#\s*//;
+			}
+			my $msg = join "\n", @lines;
+
+			SVNLog::Model::CDBI::PublicMessage->insert({
+				logentry => $logentry->id,
+				msg => $msg,
+			});
+		}
+	});
+}
+
+sub createtext : Local
+{
+	my ($self, $c) = @_;
+	my $out = generate_text();
+	$c->res->body("<tt>$out</tt>");
+}
+
+
+sub generate_text
+{
+	my @logentries = SVNLog::Model::CDBI::Logentry->recent(7);
+	
+	my $out = '';
+	for (@logentries)
+	{
+		my ($revision, $author, $date, $msg) = ($_->revision, $_->author, $_->date, $_->public_msg);
+		next unless defined $msg and $msg->msg;
+		
+		$date =~ s/T.*Z//;
+		$out .= <<EOF;
+<b>revision:</b> $revision<br>
+<b>author:</b> $author<br>
+<b>date:</b> $date<br>
+EOF
+		my $text = $msg->msg;
+		$text =~ s/&/&amp;/g;
+		$text =~ s/</&lt;/g;
+		$text =~ s/>/&gt;/g;
+		$text =~ s/\n/<br>/g;
+		$out .= $text . '<hr>';
+	}
+	
+	$out ||= 'Sorry, no data is available right now.';
+	return $out;
+}
+
+sub filter_copyfrom
+{
+	my @r = @_;
+	s/^(copyfrom)-(rev|path)$/$1_$2/ for @r;
+	@r;
+}
+
+1;

source/tools/autolog/SVNLog/lib/SVNLog/Controller/PublicMessage.pm

@@ -0,0 +1,41 @@
+package SVNLog::Controller::PublicMessage;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub default : Private {
+    my ( $self, $c ) = @_;
+    $c->forward('list');
+}
+
+sub do_edit : Local {
+    my ( $self, $c, $id ) = @_;
+    $c->form(optional => [ SVNLog::Model::CDBI::PublicMessage->columns ],
+        missing_optional_valid => 1 );
+    if ($c->form->has_missing) {
+        $c->stash->{message}='You have to fill in all fields.'.
+        'the following are missing: <b>'.
+        join(', ',$c->form->missing()).'</b>';
+    } elsif ($c->form->has_invalid) {
+        $c->stash->{message}='Some fields are not correctly filled in.'.
+        'the following are invalid: <b>'.
+    join(', ',$c->form->invalid()).'</b>';
+    } else {
+    SVNLog::Model::CDBI::PublicMessage->retrieve($id)->update_from_form( $c->form );
+    $c->stash->{message}='Updated OK';
+    }
+    $c->forward('edit');
+}
+
+sub edit : Local {
+    my ( $self, $c, $id ) = @_;
+    $c->stash->{item} = SVNLog::Model::CDBI::PublicMessage->retrieve($id);
+    $c->stash->{template} = 'PublicMessage/edit.tt';
+}
+
+sub list : Local {
+    my ( $self, $c ) = @_;
+    $c->stash->{template} = 'PublicMessage/list.tt';
+}
+
+1;

source/tools/autolog/SVNLog/lib/SVNLog/Model/CDBI.pm

@@ -0,0 +1,15 @@
+package SVNLog::Model::CDBI;
+
+use strict;
+use base 'Catalyst::Model::CDBI';
+
+__PACKAGE__->config(
+	dsn           => SVNLog->config->{cdbi}{dsn},
+	user          => '',
+	password      => '',
+	options       => {},
+	relationships => 1,
+	additional_base_classes => [qw/Class::DBI::FromForm Class::DBI::AsForm/],
+);
+
+1;

source/tools/autolog/SVNLog/lib/SVNLog/Model/CDBI/Logentry.pm

@@ -0,0 +1,9 @@
+package SVNLog::Model::CDBI::Logentry;
+
+use strict;
+
+__PACKAGE__->add_constructor(recent => "datetime(substr(date, 0, 26)) >= datetime('now', -? || ' days') ORDER BY revision DESC");
+
+__PACKAGE__->might_have(public_msg => 'SVNLog::Model::CDBI::PublicMessage');
+
+1;

source/tools/autolog/SVNLog/lib/SVNLog/Model/CDBI/Paths.pm

@@ -0,0 +1,5 @@
+package SVNLog::Model::CDBI::Paths;
+
+use strict;
+
+1;

source/tools/autolog/SVNLog/lib/SVNLog/Model/CDBI/PublicMessage.pm

@@ -0,0 +1,13 @@
+package SVNLog::Model::CDBI::PublicMessage;
+
+use strict;
+
+__PACKAGE__->set_sql(log_range => qq{
+	SELECT __TABLE__.id
+	FROM __TABLE__
+	JOIN logentry ON __TABLE__.logentry = logentry.id
+	ORDER BY revision DESC
+	LIMIT ? OFFSET ?
+});
+
+1;

source/tools/autolog/SVNLog/lib/SVNLog/View/TT.pm

@@ -0,0 +1,6 @@
+package SVNLog::View::TT;
+
+use strict;
+use base 'Catalyst::View::TT';
+
+1;

source/tools/autolog/SVNLog/root/PublicMessage/edit.tt

@@ -0,0 +1,25 @@
+
+<p>[% message %]</p>
+
+<form action="[% c.uri_for('/publicmessage/do_edit', item.id) %]" method="post">
+
+	Revision<br/>
+	[% item.logentry.revision %]<br/>
+	<br/>
+	
+	Log message<br/>
+	<tt>[% item.logentry.msg | html_line_break %]</tt><br/>
+	<br/>
+	
+	Public message<br/>
+	[%
+		textarea = item.to_field('msg');
+		CALL textarea.attr('rows', 10);
+		CALL textarea.attr('cols', 60);
+		textarea.as_XML
+	%]
+	 <br/>
+	<input type="submit" value="Save changes"/>
+</form>
+<br/>
+<a href="[% c.uri_for('/publicmessage/list') %]">Back to list</a>

source/tools/autolog/SVNLog/root/PublicMessage/list.tt

@@ -0,0 +1,33 @@
+
+[% USE table_class = Class('SVNLog::Model::CDBI::PublicMessage') %]
+<table border="1">
+    <tr>
+        <th>Revision</th>
+        <th>Author</th>
+        <th>Log message</th>
+        <th>Public message</th>
+        <th/>
+    </tr>
+    [%
+    	count = 20;
+    	start = c.req.param('start') || 0;
+    %]
+    [% FOR object = table_class.search_log_range(count, start) %]
+        <tr>
+            <td>[% object.logentry.revision %]</td>
+            <td>[% object.logentry.author %]</td>
+            <td>[% object.logentry.msg | html | html_line_break %]</td>
+            <td>[% object.msg | html | html_line_break %]</td>
+            <td>
+                <a href="[% c.uri_for('/publicmessage/edit', object.id) %]">
+                    Edit
+                </a>
+            </td>
+        </tr>
+    [% END %]
+</table>
+
+[% IF start > 0 %]
+	<a href="[% c.uri_for('/publicmessage/list') _ '?start=' _ (start-count) %]">Previous page</a> |
+[% END %]
+<a href="[% c.uri_for('/publicmessage/list') _ '?start=' _ (start+count) %]">Next page</a>

source/tools/autolog/SVNLog/script/svnlog_cgi.pl

@@ -0,0 +1,37 @@
+#!/usr/bin/perl -w
+
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use SVNLog;
+
+SVNLog->run;
+
+1;
+
+=head1 NAME
+
+svnlog_cgi.pl - Catalyst CGI
+
+=head1 SYNOPSIS
+
+See L<Catalyst::Manual>
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as cgi.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@oook.de>
+
+=head1 COPYRIGHT
+
+Copyright 2004 Sebastian Riedel. All rights reserved.
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut

source/tools/autolog/SVNLog/script/svnlog_create.pl

@@ -0,0 +1,72 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+use Catalyst::Helper;
+
+my $force = 0;
+my $mech  = 0;
+my $help  = 0;
+
+GetOptions(
+    'nonew|force'    => \$force,
+    'mech|mechanize' => \$mech,
+    'help|?'         => \$help
+ );
+
+pod2usage(1) if ( $help || !$ARGV[0] );
+
+my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, mech => $mech } );
+
+pod2usage(1) unless $helper->mk_component( 'SVNLog', @ARGV );
+
+1;
+
+=head1 NAME
+
+svnlog_create.pl - Create a new Catalyst Component
+
+=head1 SYNOPSIS
+
+svnlog_create.pl [options] model|view|controller name [helper] [options]
+
+ Options:
+   -force        don't create a .new file where a file to be created exists
+   -mechanize    use Test::WWW::Mechanize::Catalyst for tests if available
+   -help         display this help and exits
+
+ Examples:
+   svnlog_create.pl controller My::Controller
+   svnlog_create.pl -mechanize controller My::Controller
+   svnlog_create.pl view My::View
+   svnlog_create.pl view MyView TT
+   svnlog_create.pl view TT TT
+   svnlog_create.pl model My::Model
+   svnlog_create.pl model SomeDB CDBI dbi:SQLite:/tmp/my.db
+   svnlog_create.pl model AnotherDB CDBI dbi:Pg:dbname=foo root 4321
+
+ See also:
+   perldoc Catalyst::Manual
+   perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Create a new Catalyst Component.
+
+Existing component files are not overwritten.  If any of the component files
+to be created already exist the file will be written with a '.new' suffix.
+This behavior can be suppressed with the C<-force> option.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@oook.de>
+
+=head1 COPYRIGHT
+
+Copyright 2004 Sebastian Riedel. All rights reserved.
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut

source/tools/autolog/SVNLog/script/svnlog_fastcgi.pl

@@ -0,0 +1,76 @@
+#!/usr/bin/perl -w
+
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use SVNLog;
+
+my $help = 0;
+my ( $listen, $nproc, $pidfile, $manager, $detach );
+ 
+GetOptions(
+    'help|?'      => \$help,
+    'listen|l=s'  => \$listen,
+    'nproc|n=i'   => \$nproc,
+    'pidfile|p=s' => \$pidfile,
+    'manager|M=s' => \$manager,
+    'daemon|d'    => \$detach,
+);
+
+pod2usage(1) if $help;
+
+SVNLog->run( 
+    $listen, 
+    {   nproc   => $nproc,
+        pidfile => $pidfile, 
+        manager => $manager,
+        detach  => $detach,
+    }
+);
+
+1;
+
+=head1 NAME
+
+svnlog_fastcgi.pl - Catalyst FastCGI
+
+=head1 SYNOPSIS
+
+svnlog_fastcgi.pl [options]
+ 
+ Options:
+   -? -help      display this help and exits
+   -l -listen    Socket path to listen on
+                 (defaults to standard input)
+                 can be HOST:PORT, :PORT or a
+                 filesystem path
+   -n -nproc     specify number of processes to keep
+                 to serve requests (defaults to 1,
+                 requires -listen)
+   -p -pidfile   specify filename for pid file
+                 (requires -listen)
+   -d -daemon    daemonize (requires -listen)
+   -M -manager   specify alternate process manager
+                 (FCGI::ProcManager sub-class)
+                 or empty string to disable
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as fastcgi.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@oook.de>
+
+=head1 COPYRIGHT
+
+Copyright 2004 Sebastian Riedel. All rights reserved.
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut

source/tools/autolog/SVNLog/script/svnlog_server.pl

@@ -0,0 +1,104 @@
+#!/usr/bin/perl -w
+
+BEGIN { 
+    $ENV{CATALYST_ENGINE} ||= 'HTTP';
+    $ENV{CATALYST_SCRIPT_GEN} = 27;
+}  
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+my $debug         = 0;
+my $fork          = 0;
+my $help          = 0;
+my $host          = undef;
+my $port          = 3000;
+my $keepalive     = 0;
+my $restart       = 0;
+my $restart_delay = 1;
+my $restart_regex = '\.yml$|\.yaml$|\.pm$';
+
+my @argv = @ARGV;
+
+GetOptions(
+    'debug|d'           => \$debug,
+    'fork'              => \$fork,
+    'help|?'            => \$help,
+    'host=s'            => \$host,
+    'port=s'            => \$port,
+    'keepalive|k'       => \$keepalive,
+    'restart|r'         => \$restart,
+    'restartdelay|rd=s' => \$restart_delay,
+    'restartregex|rr=s' => \$restart_regex
+);
+
+pod2usage(1) if $help;
+
+if ( $restart ) {
+    $ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
+}
+if ( $debug ) {
+    $ENV{CATALYST_DEBUG} = 1;
+}
+
+# This is require instead of use so that the above environment
+# variables can be set at runtime.
+require SVNLog;
+
+SVNLog->run( $port, $host, {
+    argv          => \@argv,
+    'fork'        => $fork,
+    keepalive     => $keepalive,
+    restart       => $restart,
+    restart_delay => $restart_delay,
+    restart_regex => qr/$restart_regex/
+} );
+
+1;
+
+=head1 NAME
+
+svnlog_server.pl - Catalyst Testserver
+
+=head1 SYNOPSIS
+
+svnlog_server.pl [options]
+
+ Options:
+   -d -debug          force debug mode
+   -f -fork           handle each request in a new process
+                      (defaults to false)
+   -? -help           display this help and exits
+      -host           host (defaults to all)
+   -p -port           port (defaults to 3000)
+   -k -keepalive      enable keep-alive connections
+   -r -restart        restart when files got modified
+                      (defaults to false)
+   -rd -restartdelay  delay between file checks
+   -rr -restartregex  regex match files that trigger
+                      a restart when modified
+                      (defaults to '\.yml$|\.yaml$|\.pm$')
+
+ See also:
+   perldoc Catalyst::Manual
+   perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst Testserver for this application.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@oook.de>
+
+=head1 COPYRIGHT
+
+Copyright 2004 Sebastian Riedel. All rights reserved.
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut

source/tools/autolog/SVNLog/script/svnlog_test.pl

@@ -0,0 +1,54 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Catalyst::Test 'SVNLog';
+
+my $help = 0;
+
+GetOptions( 'help|?' => \$help );
+
+pod2usage(1) if ( $help || !$ARGV[0] );
+
+print request($ARGV[0])->content . "\n";
+
+1;
+
+=head1 NAME
+
+svnlog_test.pl - Catalyst Test
+
+=head1 SYNOPSIS
+
+svnlog_test.pl [options] uri
+
+ Options:
+   -help    display this help and exits
+
+ Examples:
+   svnlog_test.pl http://localhost/some_action
+   svnlog_test.pl /some_action
+
+ See also:
+   perldoc Catalyst::Manual
+   perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst action from the command line.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@oook.de>
+
+=head1 COPYRIGHT
+
+Copyright 2004 Sebastian Riedel. All rights reserved.
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut

source/tools/autolog/SVNLog/sql/createdb.sh

@@ -0,0 +1,2 @@
+#!/bin/bash
+sqlite3 svnlog.db < svnlog.sql

source/tools/autolog/SVNLog/sql/svnlog.sql

@@ -0,0 +1,23 @@
+CREATE TABLE logentry (
+	id INTEGER PRIMARY KEY AUTOINCREMENT,
+	revision INTEGER UNIQUE,
+	author TEXT,
+	date TEXT,
+	msg TEXT
+);
+
+CREATE TABLE paths (
+	id INTEGER PRIMARY KEY AUTOINCREMENT,
+	logentry INTEGER REFERENCES logentry,
+	action TEXT,
+	copyfrom_path TEXT,
+	copyfrom_rev INTEGER,
+	path TEXT
+);
+
+CREATE TABLE public_message (
+	id INTEGER PRIMARY KEY AUTOINCREMENT,
+	logentry INTEGER REFERENCES logentry,
+	msg TEXT
+);
+CREATE INDEX public_message_logentry ON public_message (logentry);