lib/Frey/SVK.pm

package Frey::SVK;
use Moose;

extends 'Frey';
with 'Frey::Web';
with 'Frey::Path';

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',
);

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

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

sub modified {
        my ($self) = @_;
        my @modified;
        my $svk = $self->svk('status -q', sub {
                push @modified, $1 if /^\w+\s+(.+)/;
        });
        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 status_as_markup {
        my ($self) = @_;
        my $status = `svk status -q`;
#       $status =~ s{^(\w+\s+)(\S+)$}{$1<input name="commit_path" value="$2" type="checkbox"><a href="#$2">$2</a>}gm; # FIXME
        $status =~ s{^(\w+[\+\s]+)(\S+)$}{$1<a href="#$2">$2</a>}gm;
        if ( $status ) {
                $self->add_css(qq|
                        pre.l a { text-decoration: none; }
                        div.commit {
                                background: #ffd;
                                padding: 1em 1em;
                                position: fixed;
                                top: 1em;
                                right: 1em;
                                z-index: 10;
                        }
                | );

                $status = qq|
                        <div class="commit" method="post">
                                <form>
                                <textarea name="commit_message" cols=40 rows=4></textarea>
                                <br><input type="submit" name="action" value="commit">
                                </form>
                        </div>
                        <pre class="l">$status</pre>
                |;
                $self->add_status( $status );

        }
        warn "status_as_markup ",length($status)," bytes";
        return $status;
}

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

        my $diff   = `svk diff`;

        $diff = $self->html_escape( $diff );
        $self->add_css( qq|
        pre span.add { background: #dfd }
        pre span.del { background: #fdd }
        pre form.inline { display: inline }
        | );
        $diff =~ s{^(\+.+?)$}{<span class="add">$1</span>}gm;
        $diff =~ s{^(\-.+?)$}{<span class="del">$1</span>}gm;
        sub form {
                my ( $path, $action ) = @_;
                qq|<form class="inline"><input type="hidden" name="path" value="$path"><input type="submit" name="action" value="$action"></form>|;
        };
        $diff =~ s{^(===\s+)(\S+)$}{$1 . form($2,'revert') . qq| <a name="$2" target="editor" href="/editor+$2+1">$2</a> | . form($2,'postpone') }gem;

        $diff = qq|<pre>$diff</pre>|;
        warn "diff_as_markup ",length($diff)," bytes";
        return $diff;
}

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

        my $html = '';
        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 . ' ' . $self->path;
                if ( $self->action eq 'commit' ) {
                        confess "need commit message" unless $self->commit_message;
                        my $msg = $self->commit_message;
                        $msg =~ s{"}{\\"}gs;
                        $cmd .= qq{ -m "$msg"};
                } else {
                        confess "need path" unless $self->path;
                }
        }
        if ( $cmd ) {
                $cmd .= ' 2>&1';
                my $out = `$cmd`;
                warn "$cmd $out";

                $html .= qq|
                        <code style="background: #ff8;">
                        $cmd\n
                        <b>$out</b>
                        </code>
                |;
        }

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

        $html .= $self->status_as_markup || 'No changes in files tracked by SVK';
        $html .= $self->diff_as_markup;

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

        return $html;
}

1;
1	dpavlin	485	package Frey::SVK;
2			use Moose;
3
4	dpavlin	535	extends 'Frey';
5			with 'Frey::Web';
6	dpavlin	681	with 'Frey::Path';
7	dpavlin	498
8	dpavlin	615	use Moose::Util::TypeConstraints;
9
10	dpavlin	637	enum 'SVK_Action' => ( 'commit', 'revert', 'postpone' );
11	dpavlin	615
12			has action => (
13	dpavlin	585	is => 'rw',
14	dpavlin	615	isa => 'SVK_Action',
15	dpavlin	585	);
16
17	dpavlin	615	has path => (
18			documentation => 'path to work with',
19	dpavlin	614	is => 'rw',
20	dpavlin	615	isa => 'Str',
21	dpavlin	614	);
22
23	dpavlin	620	has commit_message => (
24	dpavlin	585	documentation => 'commit message',
25			is => 'rw',
26			isa => 'Str',
27			);
28
29	dpavlin	505	sub svk {
30			my ( $self, $exec, $coderef ) = @_;
31			open(my $svk, '-\|', 'svk ' . $exec) or die "svk $exec: $@";
32			while(<$svk>) {
33			chomp;
34			$coderef->( $_ );
35			}
36			close($svk) or die "can't close svk $exec: $@";
37			}
38
39	dpavlin	485	sub modified {
40			my ($self) = @_;
41			my @modified;
42	dpavlin	505	my $svk = $self->svk('status -q', sub {
43	dpavlin	579	push @modified, $1 if /^\w+\s+(.+)/;
44	dpavlin	505	});
45	dpavlin	485	return @modified;
46			}
47
48	dpavlin	505	our $info; # cache, we use it on every hit
49			sub info {
50			my ($self) = @_;
51			return $info if $info;
52			my $svk = $self->svk('info', sub {
53			my ( $label, $value ) = split(/:\s+/, $_, 2);
54	dpavlin	535	$info->{$label} = $value if $label;
55	dpavlin	505	});
56	dpavlin	576	warn "# svk info ",$self->dump( $info );
57	dpavlin	505	return $info;
58			}
59
60	dpavlin	485	sub as_data {
61			my ($self) = @_;
62			{
63			modified => [ $self->modified ],
64			}
65			}
66
67	dpavlin	585	sub status_as_markup {
68	dpavlin	498	my ($self) = @_;
69			my $status = `svk status -q`;
70	dpavlin	615	# $status =~ s{^(\w+\s+)(\S+)$}{$1<input name="commit_path" value="$2" type="checkbox"><a href="#$2">$2</a>}gm; # FIXME
71	dpavlin	626	$status =~ s{^(\w+[\+\s]+)(\S+)$}{$1<a href="#$2">$2</a>}gm;
72	dpavlin	603	if ( $status ) {
73	dpavlin	615	$self->add_css(qq\|
74			pre.l a { text-decoration: none; }
75			div.commit {
76			background: #ffd;
77			padding: 1em 1em;
78			position: fixed;
79			top: 1em;
80			right: 1em;
81			z-index: 10;
82			}
83			\| );
84
85	dpavlin	603	$status = qq\|
86	dpavlin	622	<div class="commit" method="post">
87	dpavlin	615	<form>
88	dpavlin	620	<textarea name="commit_message" cols=40 rows=4></textarea>
89	dpavlin	615	<br><input type="submit" name="action" value="commit">
90			</form>
91	dpavlin	603	</div>
92			<pre class="l">$status</pre>
93			\|;
94			$self->add_status( $status );
95	dpavlin	615
96	dpavlin	603	}
97	dpavlin	591	warn "status_as_markup ",length($status)," bytes";
98	dpavlin	585	return $status;
99			}
100	dpavlin	576
101	dpavlin	585	sub diff_as_markup {
102			my ($self) = @_;
103
104	dpavlin	498	my $diff = `svk diff`;
105
106	dpavlin	576	$diff = $self->html_escape( $diff );
107			$self->add_css( qq\|
108			pre span.add { background: #dfd }
109			pre span.del { background: #fdd }
110	dpavlin	637	pre form.inline { display: inline }
111	dpavlin	576	\| );
112			$diff =~ s{^(\+.+?)$}{<span class="add">$1</span>}gm;
113			$diff =~ s{^(\-.+?)$}{<span class="del">$1</span>}gm;
114	dpavlin	637	sub form {
115			my ( $path, $action ) = @_;
116			qq\|<form class="inline"><input type="hidden" name="path" value="$path"><input type="submit" name="action" value="$action"></form>\|;
117			};
118			$diff =~ s{^(===\s+)(\S+)$}{$1 . form($2,'revert') . qq\| <a name="$2" target="editor" href="/editor+$2+1">$2</a> \| . form($2,'postpone') }gem;
119	dpavlin	552
120	dpavlin	576	$diff = qq\|<pre>$diff</pre>\|;
121	dpavlin	591	warn "diff_as_markup ",length($diff)," bytes";
122	dpavlin	585	return $diff;
123			}
124	dpavlin	498
125	dpavlin	585	sub as_markup {
126			my ($self) = @_;
127
128	dpavlin	614	my $html = '';
129	dpavlin	637	my $cmd;
130	dpavlin	614
131	dpavlin	637	if ( $self->action eq 'postpone' ) {
132			my $old = $self->path;
133	dpavlin	681	my $new = $old;
134			$new =~ s{/([^/]+)$}{/.postponed.$1};
135
136			die "Allready have ", $self->path_size($new) if -e $new;
137	dpavlin	637	$cmd = "mv $old $new && svk revert $old";
138			} elsif ( $self->action ) {
139	dpavlin	639	$cmd = 'svk ' . $self->action . ' ' . $self->path;
140	dpavlin	615	if ( $self->action eq 'commit' ) {
141	dpavlin	620	confess "need commit message" unless $self->commit_message;
142			my $msg = $self->commit_message;
143	dpavlin	615	$msg =~ s{"}{\\"}gs;
144			$cmd .= qq{ -m "$msg"};
145			} else {
146			confess "need path" unless $self->path;
147			}
148	dpavlin	637	}
149			if ( $cmd ) {
150	dpavlin	615	$cmd .= ' 2>&1';
151			my $out = `$cmd`;
152			warn "$cmd $out";
153	dpavlin	637
154	dpavlin	615	$html .= qq\|
155			<code style="background: #ff8;">
156			$cmd\n
157			<b>$out</b>
158			</code>
159			\|;
160	dpavlin	614	}
161
162	dpavlin	615	$self->title( 'svk' . ( $self->action ? ' - ' . $self->action : '' ) ); # XXX without this we get wrong icon and title
163	dpavlin	614
164	dpavlin	616	$html .= $self->status_as_markup \|\| 'No changes in files tracked by SVK';
165			$html .= $self->diff_as_markup;
166	dpavlin	614
167	dpavlin	591	warn "as_markup ",length($html)," bytes";
168	dpavlin	576
169	dpavlin	498	return $html;
170			}
171
172	dpavlin	485	1;