/[Frey]/trunk/lib/Frey/SVN.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

Diff of /trunk/lib/Frey/SVN.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 769 by dpavlin, Tue Dec 9 20:31:31 2008 UTC revision 807 by dpavlin, Thu Dec 11 00:27:19 2008 UTC
# Line 11  with 'Frey::Web'; Line 11  with 'Frey::Web';
11  #with 'Frey::Storage';  #with 'Frey::Storage';
12    
13  use XML::Simple;  use XML::Simple;
14    use DateTimeX::Easy;
15    
16  has repository => (  has repository => (
17          is => 'rw',          is => 'rw',
# Line 19  has repository => ( Line 20  has repository => (
20          default => 'file:///home/dpavlin/private/svn/Frey',          default => 'file:///home/dpavlin/private/svn/Frey',
21  );  );
22    
23  sub as_markup {  has limit => (
24          my ($self) = @_;          is => 'rw',
25            isa => 'Int',
26          # extract svk revision: r113@athlon (orig r999): dpavlin | 2005-09-01 20:38:07 +0200          default => 50,
27          my $svk_rev_re = '\s+(r\d+@\w+(\s+\(orig\s+r\d+\))*:\s+\w+\s+\|\s+\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2}:\d{2}\s+\+\d+)\s*';  );
   
         sub encode {  
                 my $foo = shift;  
                 $foo =~ s/$svk_rev_re//gsm;  
                 $foo =~ s/</&lt;/g;  
                 $foo =~ s/>/&gt;/g;  
                 $foo =~ s/"/&quot;/g;  
                 $foo =~ s/([\n\r][\n\r]+)/<\/p>$1<p>/gis;  
                 $foo =~ s/([\n\r]+)([\-\*]\s+)/$1<br\/>$2/gis;  
                 $foo =~ s/([\n\r]+)(r\d+:\s+)/$1<br\/>$2/gis;  
                 $foo =~ s/([\n\r]+)(\s+r\d+@)/$1<br\/>$2/gis;           # svk  
                 return $foo;  
         }  
28    
29    sub iterator {
30            my ($self,$coderef) = @_;
31            
32          sub sh_regex($$) {          sub sh_regex($$) {
33                  my ($cmd,$regex) = @_;                  my ($cmd,$regex) = @_;
34                  open(my $sh, $cmd . ' |') || die "sh_regex failed on $cmd: $!";                  open(my $sh, $cmd . ' |') || die "sh_regex failed on $cmd: $!";
# Line 87  sub as_markup { Line 78  sub as_markup {
78                  $cmd = "svn log -v --xml $svn_path";                  $cmd = "svn log -v --xml $svn_path";
79          }          }
80    
81            $cmd .= " --limit " . $self->limit if $self->limit;
82    
83          warn "# $cmd\n";          warn "# $cmd\n";
84          open(my $fh, $cmd .' |') || die "failed $cmd: $!";          open(my $fh, $cmd .' |') || die "failed $cmd: $!";
85          my $log;          my $log;
# Line 97  sub as_markup { Line 90  sub as_markup {
90    
91          my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);          my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);
92    
93            foreach my $e (@{$xml->{'logentry'}}) {
94                    warn "# e = ",$self->dump( $e );
95                    $coderef->($e);
96            }
97    }
98    
99    sub as_markup {
100            my ($self) = @_;
101    
102            # extract svk revision: r113@athlon (orig r999): dpavlin | 2005-09-01 20:38:07 +0200
103            our $svk_rev_re = '\s+(r\d+@\w+(\s+\(orig\s+r\d+\))*:\s+\w+\s+\|\s+\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2}:\d{2}\s+\+\d+)\s*';
104    
105            sub encode {
106                    my $foo = shift;
107                    $foo =~ s/$svk_rev_re//gsm;
108                    $foo =~ s/</&lt;/g;
109                    $foo =~ s/>/&gt;/g;
110                    $foo =~ s/"/&quot;/g;
111                    $foo =~ s/([\n\r][\n\r]+)/<\/p>$1<p>/gis;
112                    $foo =~ s/([\n\r]+)([\-\*]\s+)/$1<br\/>$2/gis;
113                    $foo =~ s/([\n\r]+)(r\d+:\s+)/$1<br\/>$2/gis;
114                    $foo =~ s/([\n\r]+)(\s+r\d+@)/$1<br\/>$2/gis;           # svk
115                    return $foo;
116            }
117    
118          our $html = '';          our $html = '';
119          sub html {          sub html {
120                  $html .= join("\n", @_);                  $html .= join("\n", @_);
121          }          }
122    
123          foreach my $e (@{$xml->{'logentry'}}) {          $self->iterator( sub {
124                    my $e = shift;
125    
126                  my $rev = $e->{'revision'};                  my $rev = $e->{'revision'};
127                  my $date = $e->{'date'};                  my $date = $e->{'date'};
128    
# Line 127  sub as_markup { Line 147  sub as_markup {
147    
148                  html '<blockquote><p><tt style="color:#808080">',join(", ",@files),':</tt> ',encode($e->{'msg'}),'</p></blockquote>';                  html '<blockquote><p><tt style="color:#808080">',join(", ",@files),':</tt> ',encode($e->{'msg'}),'</p></blockquote>';
149    
150          }          });
151    
152          return $html;          return $html;
153  }  }
154    
155    sub codeswarm_as_markup {
156            my ($self) = @_;
157    
158            $self->content_type('text/xml');
159    
160            my $file_events = '';
161    
162            $self->iterator( sub {
163                    my $e = shift;
164                    
165                    my $rev = $e->{'revision'};
166                    my $date = DateTimeX::Easy->new( $e->{'date'} )->epoch . '000'; # ms
167                    my $author = $e->{'author'};
168    
169                    foreach my $p (@{$e->{'paths'}->{'path'}}) {
170                            my ($action,$path) = ($p->{'action'},$p->{'content'});
171                            $file_events .= qq|\t<event filename="$path" date="$date" author="$author" />\n|;
172                    }
173    
174            });
175    
176            return qq|<?xml version="1.0"?>
177            <!-- One commit per day for one month by a documenter and programmer. -->
178            <file_events>
179            $file_events
180            </file_events>
181            |;
182    
183    }
184    
185  1;  1;
Legend:
Removed from v.769  
changed lines
  Added in v.807
  ViewVC Help
Powered by ViewVC 1.1.26