/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.26