/[Frey]/trunk/lib/Frey/SVK.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/lib/Frey/SVK.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.26