lib/Frey/SVK.pm

package Frey::SVK;
use Moose;

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

has commit_path => (
        documentation => 'path to commit',
        is => 'rw',
        isa => 'Str',
);

has 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<a href="#$2">$2</a>}gm;
        $self->add_css( qq| pre.l a { text-decoration: none; } | );
        $status = qq|<pre class="l">$status</pre>|;
        $self->add_status( $status );
        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 }
        | );
        $diff =~ s{^(\+.+?)$}{<span class="add">$1</span>}gm;
        $diff =~ s{^(\-.+?)$}{<span class="del">$1</span>}gm;
        $diff =~ s{^(===\s+)(\S+)$}{$1<a name="$2">$2</a>}gm;

        $diff = qq|<pre>$diff</pre>|;
        return $diff;
}

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

        if ( ! $self->can('html_escape') ) {
                Frey::Web->meta->apply( $self );
                $self->TODO( "Frey::Web role missing" );
        }

        my $html = $self->status_as_markup . $self->diff_as_markup;
        warn "html ",length($html)," bytes";

        return $html;
}

1;
1	package Frey::SVK;
2	use Moose;
3
4	extends 'Frey';
5	with 'Frey::Web';
6
7	has commit_path => (
8	documentation => 'path to commit',
9	is => 'rw',
10	isa => 'Str',
11	);
12
13	has message => (
14	documentation => 'commit message',
15	is => 'rw',
16	isa => 'Str',
17	);
18
19	sub svk {
20	my ( $self, $exec, $coderef ) = @_;
21	open(my $svk, '-\|', 'svk ' . $exec) or die "svk $exec: $@";
22	while(<$svk>) {
23	chomp;
24	$coderef->( $_ );
25	}
26	close($svk) or die "can't close svk $exec: $@";
27	}
28
29	sub modified {
30	my ($self) = @_;
31	my @modified;
32	my $svk = $self->svk('status -q', sub {
33	push @modified, $1 if /^\w+\s+(.+)/;
34	});
35	return @modified;
36	}
37
38	our $info; # cache, we use it on every hit
39	sub info {
40	my ($self) = @_;
41	return $info if $info;
42	my $svk = $self->svk('info', sub {
43	my ( $label, $value ) = split(/:\s+/, $_, 2);
44	$info->{$label} = $value if $label;
45	});
46	warn "# svk info ",$self->dump( $info );
47	return $info;
48	}
49
50	sub as_data {
51	my ($self) = @_;
52	{
53	modified => [ $self->modified ],
54	}
55	}
56
57	sub status_as_markup {
58	my ($self) = @_;
59	my $status = `svk status -q`;
60	$status =~ s{^(\w+\s+)(\S+)$}{$1<a href="#$2">$2</a>}gm;
61	$self->add_css( qq\| pre.l a { text-decoration: none; } \| );
62	$status = qq\|<pre class="l">$status</pre>\|;
63	$self->add_status( $status );
64	return $status;
65	}
66
67	sub diff_as_markup {
68	my ($self) = @_;
69
70	my $diff = `svk diff`;
71
72	$diff = $self->html_escape( $diff );
73	$self->add_css( qq\|
74	pre span.add { background: #dfd }
75	pre span.del { background: #fdd }
76	\| );
77	$diff =~ s{^(\+.+?)$}{<span class="add">$1</span>}gm;
78	$diff =~ s{^(\-.+?)$}{<span class="del">$1</span>}gm;
79	$diff =~ s{^(===\s+)(\S+)$}{$1<a name="$2">$2</a>}gm;
80
81	$diff = qq\|<pre>$diff</pre>\|;
82	return $diff;
83	}
84
85	sub as_markup {
86	my ($self) = @_;
87
88	if ( ! $self->can('html_escape') ) {
89	Frey::Web->meta->apply( $self );
90	$self->TODO( "Frey::Web role missing" );
91	}
92
93	my $html = $self->status_as_markup . $self->diff_as_markup;
94	warn "html ",length($html)," bytes";
95
96	return $html;
97	}
98
99	1;