lib/Frey/SVK.pm

package Frey::SVK;
use Moose;

extends 'Frey';
with 'Frey::Web', 'Frey::Path', 'Frey::HTML::Diff';

use Moose::Util::TypeConstraints;

enum 'SVK_Action' => ( 'commit', 'revert', 'postpone' );

has action => (
        is => 'rw',
        isa => 'SVK_Action',
);

has path => (
        documentation => 'path to work with',
        is => 'rw',
        isa => 'Str|ArrayRef',
);

has commit_message => (
        documentation => 'commit message',
        is => 'rw',
        isa => 'Str',
);

our $svk = 'svk';
$svk = 'svn' if -e '.svn';
warn "using $svk";

sub svk {
        my ( $self, $exec, $coderef ) = @_;
        open(my $pipe, '-|', "$svk $exec") or die "$svk $exec: $@";
        while(<$pipe>) {
                chomp;
                $coderef->( $_ );
        }
        close($pipe) or die "can't close $svk $exec: $@";
}

our $svk_status_path = '^(\w+[\+\s]+)(.+)';

sub modified {
        my ($self) = @_;
        my @modified;
        my $svk = $self->svk('status -q', sub {
                push @modified, $2 if m{$svk_status_path};
        });
        return @modified;
}

our $info; # cache, we use it on every hit
sub info {
        my ($self) = @_;
        return $info if $info;
        my $svk = $self->svk('info', sub {
                my ( $label, $value ) = split(/:\s+/, $_, 2);
                $info->{$label} = $value if $label;
        });
        warn "# $svk info ",$self->dump( $info );
        return $info;
}

sub as_data {
        my ($self) = @_;
        {
                modified => [ $self->modified ],
        }
}

sub commit_as_markup {
        my ($self) = @_;
        my $status = `$svk status -q`;
        $status =~ s{$svk_status_path}{$1 . $self->checkbox('path',$2) . qq|<a href="#$2">$2</a>|}egm;
        if ( $status ) {
                $self->add_css(qq|
                        pre.l a { text-decoration: none; }
                        form.commit {
                                background: #eee;
                                padding: 1em 1em;
                                position: fixed;
                                top: 1em;
                                right: 1em;
                                z-index: 10;
                                opacity: .2;
                                filter: alpha(opacity=20);
                        }
                        form.commit:hover {
                                opacity: 1;
                                filter: alpha(opacity=100);
                        }
                | );


                $status = qq|
                        <form class="commit" method="post">
                        <pre class="l">$status</pre>
                        <textarea name="commit_message" cols=40 rows=4></textarea>
                        <br>
                        <a target="Frey::Test::Runner" href="/Frey::Test::Runner/as_markup" title="run tests for all changes" style="float: right;">test</a>
                        <input type="submit" name="action" value="commit">
                        </form>
                |;
                $self->add_status( status => $status );
                warn "commit_as_markup ",length($status)," bytes";
        }
        return $status;
}

sub diff_as_markup {
        my ($self) = @_;

        my $diff   = `$svk diff`;
        $self->add_status( diff => $diff );

        $diff = $self->html_diff( $diff );

        sub form {
                my ( $path, $action ) = @_;
                qq|<form class="inline" method="post"><input type="hidden" name="path" value="$path"><input type="submit" name="action" value="$action"></form>|;
        };
        $diff =~ s{(^|<pre>)(===\s+)(\S+)$}{$1 . $2 . form($3,'revert') . qq| <a name="$3" target="editor" href="/editor+$3+1">$3</a> | . form($3,'postpone') }gem;

        warn "diff_as_markup ",length($diff)," bytes";
        return $diff;
}

sub action_as_markup {
        my ($self) = @_;

        my $cmd;

        if ( $self->action eq 'postpone' ) {
                my $old = $self->path;
                my $new = $old;
                $new =~ s{/([^/]+)$}{/.postponed.$1};
        
                die "Allready have ", $self->path_size($new) if -e $new;
                $cmd = "mv $old $new && $svk revert $old";
        } elsif ( $self->action ) {
                $cmd = "$svk " . $self->action;
                if ( $self->action eq 'commit' ) {
                        my $msg = $self->commit_message || return $self->error( "need commit message\n" );
                        $msg =~ s{"}{\\"}gs;
                        $cmd .= qq{ -m "$msg"};
                } else {
                        confess "need path" unless $self->path;
                }

                my @paths = eval { @{ $self->path } }; # XXX sigh!
                @paths = ( $self->path ) unless @paths;
                warn "# path ", $self->dump( @paths );

                $cmd .= ' ' . join( ' ',@paths );
        }
        if ( $cmd ) {
                $cmd .= ' 2>&1';
                warn "# cmd $cmd";

                my $out = `$cmd`;
                warn "# output of $cmd is: $out";

                return qq|
                        Command <tt>$cmd</tt> produced output:
                        <pre style="background: #ff8;">$out</pre>
                        <a href="">reload page</a> to prevent this post from triggering again<br>
                |;
        }

}

sub as_markup {
        my ($self) = @_;

        my $html = $self->action_as_markup;

        $self->title( $svk . ( $self->action ? ' - ' . $self->action : '' ) ); # XXX without this we get wrong icon and title

        $html .= $self->commit_as_markup . $self->diff_as_markup ||
                qq|No changes in tracked files|;

        warn "as_markup ",length($html)," bytes";

        return $html;
}

__PACKAGE__->meta->make_immutable;
no Moose;
no Moose::Util::TypeConstraints;

1;
1	dpavlin	485	package Frey::SVK;
2			use Moose;
3
4	dpavlin	535	extends 'Frey';
5	dpavlin	1133	with 'Frey::Web', 'Frey::Path', 'Frey::HTML::Diff';
6	dpavlin	498
7	dpavlin	615	use Moose::Util::TypeConstraints;
8
9	dpavlin	637	enum 'SVK_Action' => ( 'commit', 'revert', 'postpone' );
10	dpavlin	615
11			has action => (
12	dpavlin	585	is => 'rw',
13	dpavlin	615	isa => 'SVK_Action',
14	dpavlin	585	);
15
16	dpavlin	615	has path => (
17			documentation => 'path to work with',
18	dpavlin	614	is => 'rw',
19	dpavlin	690	isa => 'Str\|ArrayRef',
20	dpavlin	614	);
21
22	dpavlin	620	has commit_message => (
23	dpavlin	585	documentation => 'commit message',
24			is => 'rw',
25			isa => 'Str',
26			);
27
28	dpavlin	1139	our $svk = 'svk';
29			$svk = 'svn' if -e '.svn';
30			warn "using $svk";
31
32	dpavlin	505	sub svk {
33			my ( $self, $exec, $coderef ) = @_;
34	dpavlin	1139	open(my $pipe, '-\|', "$svk $exec") or die "$svk $exec: $@";
35			while(<$pipe>) {
36	dpavlin	505	chomp;
37			$coderef->( $_ );
38			}
39	dpavlin	1139	close($pipe) or die "can't close $svk $exec: $@";
40	dpavlin	505	}
41
42	dpavlin	767	our $svk_status_path = '^(\w+[\+\s]+)(.+)';
43
44	dpavlin	485	sub modified {
45			my ($self) = @_;
46			my @modified;
47	dpavlin	505	my $svk = $self->svk('status -q', sub {
48	dpavlin	767	push @modified, $2 if m{$svk_status_path};
49	dpavlin	505	});
50	dpavlin	485	return @modified;
51			}
52
53	dpavlin	505	our $info; # cache, we use it on every hit
54			sub info {
55			my ($self) = @_;
56			return $info if $info;
57			my $svk = $self->svk('info', sub {
58			my ( $label, $value ) = split(/:\s+/, $_, 2);
59	dpavlin	535	$info->{$label} = $value if $label;
60	dpavlin	505	});
61	dpavlin	1139	warn "# $svk info ",$self->dump( $info );
62	dpavlin	505	return $info;
63			}
64
65	dpavlin	485	sub as_data {
66			my ($self) = @_;
67			{
68			modified => [ $self->modified ],
69			}
70			}
71
72	dpavlin	684	sub commit_as_markup {
73	dpavlin	498	my ($self) = @_;
74	dpavlin	1139	my $status = `$svk status -q`;
75	dpavlin	767	$status =~ s{$svk_status_path}{$1 . $self->checkbox('path',$2) . qq\|<a href="#$2">$2</a>\|}egm;
76	dpavlin	603	if ( $status ) {
77	dpavlin	615	$self->add_css(qq\|
78			pre.l a { text-decoration: none; }
79	dpavlin	684	form.commit {
80	dpavlin	690	background: #eee;
81	dpavlin	615	padding: 1em 1em;
82			position: fixed;
83			top: 1em;
84			right: 1em;
85			z-index: 10;
86	dpavlin	737	opacity: .2;
87			filter: alpha(opacity=20);
88	dpavlin	615	}
89	dpavlin	737	form.commit:hover {
90			opacity: 1;
91			filter: alpha(opacity=100);
92			}
93	dpavlin	615	\| );
94
95	dpavlin	684
96	dpavlin	603	$status = qq\|
97	dpavlin	684	<form class="commit" method="post">
98	dpavlin	603	<pre class="l">$status</pre>
99	dpavlin	684	<textarea name="commit_message" cols=40 rows=4></textarea>
100	dpavlin	863	<br>
101			<a target="Frey::Test::Runner" href="/Frey::Test::Runner/as_markup" title="run tests for all changes" style="float: right;">test</a>
102			<input type="submit" name="action" value="commit">
103	dpavlin	684	</form>
104	dpavlin	603	\|;
105	dpavlin	684	$self->add_status( status => $status );
106			warn "commit_as_markup ",length($status)," bytes";
107	dpavlin	603	}
108	dpavlin	585	return $status;
109			}
110	dpavlin	576
111	dpavlin	585	sub diff_as_markup {
112			my ($self) = @_;
113
114	dpavlin	1139	my $diff = `$svk diff`;
115	dpavlin	684	$self->add_status( diff => $diff );
116	dpavlin	498
117	dpavlin	1063	$diff = $self->html_diff( $diff );
118
119	dpavlin	637	sub form {
120			my ( $path, $action ) = @_;
121	dpavlin	712	qq\|<form class="inline" method="post"><input type="hidden" name="path" value="$path"><input type="submit" name="action" value="$action"></form>\|;
122	dpavlin	637	};
123	dpavlin	1176	$diff =~ s{(^\|<pre>)(===\s+)(\S+)$}{$1 . $2 . form($3,'revert') . qq\| <a name="$3" target="editor" href="/editor+$3+1">$3</a> \| . form($3,'postpone') }gem;
124	dpavlin	552
125	dpavlin	591	warn "diff_as_markup ",length($diff)," bytes";
126	dpavlin	585	return $diff;
127			}
128	dpavlin	498
129	dpavlin	690	sub action_as_markup {
130	dpavlin	585	my ($self) = @_;
131
132	dpavlin	637	my $cmd;
133	dpavlin	614
134	dpavlin	637	if ( $self->action eq 'postpone' ) {
135			my $old = $self->path;
136	dpavlin	681	my $new = $old;
137			$new =~ s{/([^/]+)$}{/.postponed.$1};
138
139			die "Allready have ", $self->path_size($new) if -e $new;
140	dpavlin	1139	$cmd = "mv $old $new && $svk revert $old";
141	dpavlin	637	} elsif ( $self->action ) {
142	dpavlin	1139	$cmd = "$svk " . $self->action;
143	dpavlin	615	if ( $self->action eq 'commit' ) {
144	dpavlin	690	my $msg = $self->commit_message \|\| return $self->error( "need commit message\n" );
145	dpavlin	615	$msg =~ s{"}{\\"}gs;
146			$cmd .= qq{ -m "$msg"};
147			} else {
148			confess "need path" unless $self->path;
149			}
150	dpavlin	720
151			my @paths = eval { @{ $self->path } }; # XXX sigh!
152			@paths = ( $self->path ) unless @paths;
153			warn "# path ", $self->dump( @paths );
154
155			$cmd .= ' ' . join( ' ',@paths );
156	dpavlin	637	}
157			if ( $cmd ) {
158	dpavlin	615	$cmd .= ' 2>&1';
159	dpavlin	690	warn "# cmd $cmd";
160
161	dpavlin	615	my $out = `$cmd`;
162	dpavlin	690	warn "# output of $cmd is: $out";
163	dpavlin	637
164	dpavlin	690	return qq\|
165			Command <tt>$cmd</tt> produced output:
166	dpavlin	726	<pre style="background: #ff8;">$out</pre>
167	dpavlin	848	<a href="">reload page</a> to prevent this post from triggering again<br>
168	dpavlin	615	\|;
169	dpavlin	614	}
170
171	dpavlin	690	}
172
173			sub as_markup {
174			my ($self) = @_;
175
176			my $html = $self->action_as_markup;
177
178	dpavlin	1139	$self->title( $svk . ( $self->action ? ' - ' . $self->action : '' ) ); # XXX without this we get wrong icon and title
179	dpavlin	614
180	dpavlin	698	$html .= $self->commit_as_markup . $self->diff_as_markup \|\|
181			qq\|No changes in tracked files\|;
182	dpavlin	614
183	dpavlin	591	warn "as_markup ",length($html)," bytes";
184	dpavlin	576
185	dpavlin	498	return $html;
186			}
187
188	dpavlin	1133	__PACKAGE__->meta->make_immutable;
189			no Moose;
190			no Moose::Util::TypeConstraints;
191
192	dpavlin	485	1;