File: Patch.pm

package info (click to toggle)
libalien-wxwidgets-perl 0.50%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 576 kB
  • ctags: 368
  • sloc: perl: 5,259; sh: 48; makefile: 13
file content (169 lines) | stat: -rw-r--r-- 3,568 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
#!/usr/bin/perl
package Text::Patch;
use Exporter;
our @ISA = qw( Exporter );
our @EXPORT = qw( patch );
our $VERSION = '1.1';
use strict;
use warnings;
use Carp;

sub patch
{
  my $text = shift;
  my $diff = shift;
  my %options;
  
  if( ref $_[0] eq 'HASH' )
    {
    %options = %{ $_[0] };
    }
  else
    {
    %options = @_;
    }  

  return patch_unified( $text, $diff ) if $options{ 'STYLE' } eq 'Unified';
  croak "required STYLE option is missing";
}

sub patch_unified
{
  my $text = shift;
  my $diff = shift;
  
  my @text = split /^/m, $text;
  my @diff = split /^/m, $diff;
  
  my @hunks;
  my %hunk;
  
  for( @diff )
    {
    #print STDERR ">>> ... $_";
    if( /^\@\@\s*-(\d+),(\d+)/ )
      {
      #print STDERR ">>> *** HUNK!\n";
      push @hunks, { %hunk };
      %hunk = ();
      $hunk{ FROM } = $1 - 1; # diff is 1-based
      $hunk{ LEN  } = $2;
      $hunk{ DATA } = [];
      }
    push @{ $hunk{ DATA } }, $_;
    }
  push @hunks, { %hunk }; # push last hunk
  shift @hunks; # first is always empty  

  for my $hunk ( reverse @hunks )
    {
    #use Data::Dumper;
    #print STDERR Dumper( $hunk );
    my @pdata;
    for( @{ $hunk->{ DATA } } )
      {
      next unless s/^([ \-\+])//;
      #print STDERR ">>> ($1) $_";
      next if $1 eq '-';
      push @pdata, $_;
      }
    splice @text, $hunk->{ FROM }, $hunk->{ LEN }, @pdata;
    }
  
  return join '', @text;  
}

=pod

=head1 NAME

Text::Patch - Patches text with given patch

=head1 SYNOPSIS

    use Text::Patch;
    
    $output = patch( $source, $diff, STYLE => "Unified" );

    use Text::Diff;
    
    $src  = ...
    $dst  = ...
    
    $diff = diff( $src, $dst, { STYLE => 'Unified' } );
    
    $out  = patch( $src, $diff, { STYLE => 'Unified' } );
    
    print "Patch successful" if $out eq $dst;

=head1 DESCRIPTION

Text::Patch combines source text with given diff (difference) data. 
Diff data is produced by Text::Diff module or by the standard diff
utility (man diff, see -u option).

=over 4

=item patch( $source, $diff, options... )

First argument is source (original) text. Second is the diff data.
Third argument can be either hash reference with options or all the
rest arguments will be considered patch options:

    $output = patch( $source, $diff, STYLE => "Unified", ... );

    $output = patch( $source, $diff, { STYLE => "Unified", ... } );

Options are:

  STYLE => 'Unified'
  
Note that currently only 'Unified' diff format is supported!
STYLE names are the same described in Text::Diff.

The 'Unified' diff format looks like this:

  @@ -1,7 +1,6 @@
  -The Way that can be told of is not the eternal Way;
  -The name that can be named is not the eternal name.
   The Nameless is the origin of Heaven and Earth;
  -The Named is the mother of all things.
  +The named is the mother of all things.
  +
   Therefore let there always be non-being,
     so we may see their subtlety,
   And let there always be being,
  @@ -9,3 +8,6 @@
   The two are the same,
   But after they are produced,
     they have different names.
  +They both may be called deep and profound.
  +Deeper and more profound,
  +The door of all subtleties!


=back

=head1 LIMITS

  Only 'Unified' diff format is supported.
  
=head1 TODO

  Interfaces with files, arrays, etc.
  Diff formats support: "Context", "OldStyle" (As noted in Text::Diff)

=head1 AUTHOR

  Vladi Belperchinov-Shabanski "Cade"
 
  <cade@biscom.net> <cade@datamax.bg> <cade@cpan.org>

  http://cade.datamax.bg

=head1 VERSION

  $Id: Patch.pm,v 1.2 2004/12/07 21:26:41 cade Exp $

=cut