SVN2GitEditor.pm

   1
   2 package SVN2GitEditor;
   3 use strict;
   4
   5 require SVN::Delta;
   6 our @ISA = qw(SVN::Delta::Editor);
   7
   8 use SVK::I18N;
   9 use SVK::XD;
  10 use autouse 'SVK::Util' => qw( slurp_fh tmpfile mimetype_is_text catfile );
  11
  12 sub set_target_revision {
  13     my ($self, $revision) = @_;
  14 }
  15
  16 sub open_root {
  17     my ($self, $baserev) = @_;
  18     return '';
  19 }
  20
  21 sub add_file {
  22     my ($self, $path, $pdir, $from_path, $from_rev, $pool) = @_;
  23     $self->{info}{$path}{fpool} = $pool;
  24     if (defined $from_path) {
  25         $self->{info}{$path}{from_path} = $from_path;
  26         $self->{info}{$path}{copied} = 1;
  27     } else {
  28         $self->{info}{$path}{added} = 1;
  29     }
  30     return $path;
  31 }
  32
  33 sub open_file {
  34     my ($self, $path, $pdir, $rev, $pool) = @_;
  35     $self->{info}{$path}{from_path} = $path;
  36     $self->{info}{$path}{fpool} = $pool;
  37
  38     return $path;
  39 }
  40
  41 sub apply_textdelta {
  42     my ($self, $path, $checksum, $pool) = @_;
  43     return unless $path;
  44     my $info = $self->{info}{$path};
  45     $info->{base} = $self->{cb_basecontent}($info->{from_path}, $info->{fpool})
  46         unless $info->{added};
  47
  48     unless ($self->{external}) {
  49         my $newtype = $info->{prop} && $info->{prop}{'svn:mime-type'};
  50         my $is_text = !$newtype || mimetype_is_text ($newtype);
  51         if ($is_text && !$info->{added}) {
  52             my $basetype = $self->{cb_baseprop}->($info->{from_path}, 'svn:mime-type', $pool);
  53             $is_text = !$basetype || mimetype_is_text ($basetype);
  54         }
  55         unless ($is_text) {
  56             confess("Cannot display: file marked as a binary type.\n");
  57         }
  58     }
  59     my $new;
  60     if ($self->{external}) {
  61         my $tmp = tmpfile ('diff');
  62         slurp_fh ($info->{base}, $tmp)
  63             if $info->{base};
  64         seek $tmp, 0, 0;
  65         $info->{base} = $tmp;
  66         $info->{new} = $new = tmpfile ('diff');
  67     }
  68     else {
  69         $info->{new} = '';
  70         open $new, '>', \$info->{new};
  71     }
  72
  73     return [SVN::TxDelta::apply ($info->{base}, $new,
  74                                  undef, undef, $pool)];
  75 }
  76
  77 sub close_file {
  78     my ($self, $path, $checksum, $pool) = @_;
  79     return unless $path;
  80     my $info = $self->{info}{$path};
  81
  82     if (exists $info->{new}) {
  83         no warnings 'uninitialized';
  84         my $rpath = $self->{report} ? catfile($self->{report}, $path) : $path;
  85         my @label = map { $self->{$_} || $self->{"cb_$_"}->($path) } qw/llabel rlabel/;
  86         my $showpath = ($self->{lpath} ne $self->{rpath});
  87         my @showpath = map { $showpath ? $self->{$_} : undef } qw/lpath rpath/;
  88         if ($self->{external}) {
  89             # XXX: the 2nd file could be - and save some disk IO
  90             my @content = map { ($info->{$_}->filename) } qw/base new/;
  91             @content = reverse @content if $self->{reverse};
  92             (system (split (/ /, $self->{external}),
  93                     '-L', _full_label ($rpath, $showpath[0], $label[0]),
  94                     $content[0],
  95                     '-L', _full_label ($rpath, $showpath[1], $label[1]),
  96                     $content[1]) >= 0) or die loc("Could not run %1: %2", $self->{external}, $?);
  97         }
  98         else {
  99             $info->{base} = '';
 100             $info->{base} = $self->{cb_basecontent}($info->{from_path}, $info->{fpool})
 101                 unless $info->{added};
 102             my @content = ($info->{base}, \$self->{info}{$path}{new});
 103             @content = reverse @content if $self->{reverse};
 104             $self->output_diff ($rpath, @label, @showpath, @content);
 105         }
 106     }
 107
 108 #    $self->output_prop_diff ($path, $pool);
 109     delete $self->{info}{$path};
 110 }
 111
 112 sub oldfilemode
 113 {
 114         my ($self, $path) = @_;
 115         my $pool = $self->{info}{$path}{fpool};
 116         my $name = "svn:executable";
 117
 118         return undef if $self->{info}{$path}{added};
 119
 120         my $prop = $self->{cb_baseprop}->($path, $name, $pool);
 121
 122         return "100644" unless defined($prop);
 123
 124         return "100755" if (length($prop) > 0);
 125
 126         return "100644";
 127 }
 128
 129 sub newfilemode
 130 {
 131         my ($self, $path, $oldmode) = @_;
 132         my $name = "svn:executable";
 133
 134         return undef if $self->{info}{$path}{deleted};
 135
 136         my $prop = $self->{info}{$path}{prop}{$name};
 137
 138         my $changed = 1;
 139         $changed = 0 unless defined($prop);
 140         $changed = 1 if $self->{info}{$path}{added};
 141
 142         return $oldmode unless $changed;
 143
 144         return "100755" if (length($prop) > 0);
 145
 146         return "100644";
 147 }
 148
 149 sub output_diff {
 150     my ($self, $path, $llabel, $rlabel, $lpath, $rpath) = splice(@_, 0, 6);
 151     my $fh = $self->_output_fh;
 152
 153     my $ofile = $self->{info}{$path}{added} ? "/dev/null": "a/$path";
 154     my $nfile = $self->{info}{$path}{deleted} ? "/dev/null": "b/$path";
 155
 156     my $osha1 = $self->{info}{$path}{added} ? "0000000": "1234567";
 157     my $nsha1 = $self->{info}{$path}{deleted} ? "0000000": "7654321";
 158
 159     my $omode = $self->oldfilemode($path);
 160     my $nmode = $self->newfilemode($path, $omode);
 161
 162     my $name = "";
 163     my $mode = "";
 164
 165     if (defined($omode) and defined($nmode)) {
 166         if ($omode ne $nmode) {
 167             $mode = "old mode $omode\nnew mode $nmode\n";
 168         }
 169     } elsif (defined($omode)) {
 170         $mode = "deleted file mode $omode\n";
 171     } elsif (defined($nmode)) {
 172         $mode = "new file mode $nmode\n";
 173     }
 174
 175     print $fh (
 176         "diff --git $ofile $nfile\n",
 177         $name,
 178         $mode,
 179         "index $osha1..$nsha1\n"
 180     );
 181
 182     unshift @_, $self->_output_fh;
 183     push @_, $ofile, $nfile;
 184
 185     goto &{$self->can('_output_diff_content')};
 186 }
 187
 188 # _output_diff_content($fh, $ltext, $rtext, $llabel, $rlabel)
 189 sub _output_diff_content {
 190     my ($fh, $ltext, $rtext, $llabel, $rlabel) = @_;
 191
 192     my ($lfh, $lfn) = tmpfile ('diff');
 193     my ($rfh, $rfn) = tmpfile ('diff');
 194
 195     slurp_fh ($ltext => $lfh); close ($lfh);
 196     slurp_fh ($rtext => $rfh); close ($rfh);
 197
 198     my $diff = SVN::Core::diff_file_diff( $lfn, $rfn );
 199
 200     SVN::Core::diff_file_output_unified(
 201         $fh, $diff, $lfn, $rfn, $llabel, $rlabel
 202     );
 203
 204     unlink ($lfn, $rfn);
 205 }
 206
 207 sub output_prop_diff {
 208     my ($self, $path, $pool) = @_;
 209     if ($self->{info}{$path}{prop}) {
 210         my $rpath = $self->{report} ? catfile($self->{report}, $path) : $path;
 211         $self->_print("\n", loc("Property changes on: %1\n", $rpath), ('_' x 67), "\n");
 212         for (sort keys %{$self->{info}{$path}{prop}}) {
 213             $self->_print(loc("Name: %1\n", $_));
 214             my $baseprop;
 215             $baseprop = $self->{cb_baseprop}->($path, $_, $pool)
 216                 unless $self->{info}{$path}{added};
 217             my @args =
 218                 map \$_,
 219                 map { (length || /\n$/) ? "$_\n" : $_ }
 220                     ($baseprop||''), ($self->{info}{$path}{prop}{$_}||'');
 221             @args = reverse @args if $self->{reverse};
 222
 223             my $diff = '';
 224             open my $fh, '>', \$diff;
 225             _output_diff_content($fh, @args, '', '');
 226             $diff =~ s/.*\n.*\n//;
 227             $diff =~ s/^\@.*\n//mg;
 228             $diff =~ s/^/ /mg;
 229             $self->_print($diff);
 230         }
 231         $self->_print("\n");
 232     }
 233 }
 234
 235 sub add_directory {
 236     my ($self, $path, $pdir, @arg) = @_;
 237 #    $self->{info}{$path}{added} = 1;
 238     return $path;
 239 }
 240
 241 sub open_directory {
 242     my ($self, $path, $pdir, $rev, @arg) = @_;
 243     return $path;
 244 }
 245
 246 sub close_directory {
 247     my ($self, $path, $pool) = @_;
 248 #    $self->output_prop_diff ($path, $pool);
 249     delete $self->{info}{$path};
 250 }
 251
 252 sub delete_entry {
 253     my ($self, $path, $revision, $pdir, $pool) = @_;
 254
 255     my $fullpath = "$self->{oldbranch}/$path";
 256
 257     if ($self->{oldroot}->is_file($fullpath)) {
 258         $self->{info}{$path}{from_path} = $path;
 259         $self->{info}{$path}{deleted} = 1;
 260         $self->{info}{$path}{fpool} = $pool;
 261         $self->{info}{$path}{new} = '';
 262         $self->close_file($path, undef, $pool);
 263         return;
 264     }
 265
 266     my $entries = $self->{oldroot}->dir_entries($fullpath);
 267     foreach my $c (keys %{$entries}) {
 268         $self->delete_entry("$path/$c", $revision, $path, $pool);
 269     }
 270 }
 271
 272 sub change_file_prop {
 273     my ($self, $path, $name, $value) = @_;
 274     $self->{info}{$path}{prop}{$name} = $value;
 275 }
 276
 277 sub change_dir_prop {
 278     my ($self, $path, $name, $value) = @_;
 279 }
 280
 281 sub close_edit {
 282     my ($self, @arg) = @_;
 283 }
 284
 285 sub _print {
 286     my $self = shift;
 287     $self->{output} or return print @_;
 288     ${ $self->{output} } .= $_ for @_;
 289 }
 290
 291 sub _output_fh {
 292     my $self = shift;
 293
 294     no strict 'refs';
 295     $self->{output} or return \*{select()};
 296
 297     open my $fh, '>>', $self->{output};
 298     return $fh;
 299 }
 300
 301 =head1 AUTHORS
 302
 303 Chia-liang Kao E<lt>clkao@clkao.orgE<gt>
 304
 305 =head1 COPYRIGHT
 306
 307 Copyright 2003-2005 by Chia-liang Kao E<lt>clkao@clkao.orgE<gt>.
 308
 309 This program is free software; you can redistribute it and/or modify it
 310 under the same terms as Perl itself.
 311
 312 See L<http://www.perl.com/perl/misc/Artistic.html>
 313
 314 =cut
 315
 316 1;