~alex.muntada/padre/libfile-localizenewlines-perl

« back to all changes in this revision

Viewing changes to lib/File/LocalizeNewlines.pm

  • Committer: Alex Muntada
  • Date: 2008-08-25 02:17:08 UTC
  • Revision ID: alexm@alexm.org-20080825021708-iftlc44dc2a00px3
Tags: upstream-1.10
import package from libfile-localizenewlines-perl_1.10-0~alexm1.tar.gz

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
package File::LocalizeNewlines;
 
2
 
 
3
=pod
 
4
 
 
5
=head1 NAME
 
6
 
 
7
File::LocalizeNewlines - Localize the newlines for one or more files
 
8
 
 
9
=head1 DESCRIPTION
 
10
 
 
11
For people that routinely work with a mixture of different platforms
 
12
that have conflicting newline formats (mainly *NIX and Win32) there
 
13
are a number of different situations that can result in files having
 
14
their newlines get corrupted.
 
15
 
 
16
File::LocalizeNewlines provides a mechanism for one off or bulk
 
17
detection and conversion of these files to the newline style for the
 
18
local platform.
 
19
 
 
20
The module implements the conversion using a standard "universal line
 
21
seperator" regex, which ensures that files with any of the different
 
22
newlines, plus a couple of common "broken" newlines, including
 
23
multiple different types mixed in the same file, are all converted to
 
24
the local platform's newline style.
 
25
 
 
26
=head1 METHODS
 
27
 
 
28
=cut
 
29
 
 
30
use 5.005;
 
31
use strict;
 
32
use Class::Default   ();
 
33
use File::Find::Rule ();
 
34
use File::Slurp      ();
 
35
use FileHandle       ();
 
36
use Params::Util     '_INSTANCE';
 
37
 
 
38
use vars qw{$VERSION @ISA};
 
39
BEGIN {
 
40
        $VERSION = '1.10';
 
41
        @ISA     = 'Class::Default';
 
42
}
 
43
 
 
44
 
 
45
 
 
46
 
 
47
 
 
48
#####################################################################
 
49
# Constructor and Accessors
 
50
 
 
51
=pod
 
52
 
 
53
=head2 new param => value, ...
 
54
 
 
55
The C<new> constructor creates a new conversion object.
 
56
 
 
57
By default, the conversion object will process all files and convert
 
58
them to the local platform's newline format.
 
59
 
 
60
Takes some optional parameters
 
61
 
 
62
=over
 
63
 
 
64
=item filter =E<gt> File::Find::Rule
 
65
 
 
66
The C<filter> param allows you to provide an instantiate
 
67
L<File::Find::Rule> object, that will used to determine the list of
 
68
files to check or process.
 
69
 
 
70
=item newline =E<gt> $newline
 
71
 
 
72
The C<newline> option allows you to provide an alternative newline
 
73
format to the local one. The newline format should be provided as a
 
74
literal string.
 
75
 
 
76
For example, to force Win32 newlines, you would use 
 
77
 
 
78
  my $Object = File::LocalizeNewlines->new( newline => "\015\012" );
 
79
 
 
80
=item verbose =E<gt> 1
 
81
 
 
82
The C<verbose> option will cause the C<File::LocalizeNewlines> object to
 
83
print status information to C<STDOUT> as it runs.
 
84
 
 
85
=back
 
86
 
 
87
Returns a new C<File::LocalizeNewlines> object.
 
88
 
 
89
=cut
 
90
 
 
91
sub new {
 
92
        my $class = ref $_[0] ? ref shift : shift;
 
93
        my %args  = @_;
 
94
 
 
95
        # Create the basic object
 
96
        my $self = bless { }, $class;
 
97
 
 
98
        # Check the file filter
 
99
        if ( _INSTANCE($args{filter}, 'File::Find::Rule') ) {
 
100
                $self->{Find} = $args{filter};
 
101
                $self->{Find}->file->relative;
 
102
        }
 
103
 
 
104
        # Allow for a custom platform
 
105
        $self->{newline} = $args{newline} if $args{newline};
 
106
 
 
107
        # Check the verbose mode
 
108
        if ( _CAN($args{verbose}, 'print') ) {
 
109
                $self->{verbose} = $args{verbose};
 
110
        } elsif ( $args{verbose} ) {
 
111
                $self->{verbose} = 1;
 
112
        }
 
113
 
 
114
        $self;
 
115
}
 
116
 
 
117
=pod
 
118
 
 
119
=head2 Find
 
120
 
 
121
The C<Find> accessor returns the L<File::Find::Rule> object that will be
 
122
used for the file search.
 
123
 
 
124
=cut
 
125
 
 
126
sub Find {
 
127
        my $self = $_[0]->_self;
 
128
        $self->{Find} or File::Find::Rule->file->relative;
 
129
}
 
130
 
 
131
=pod
 
132
 
 
133
=head2 newline
 
134
 
 
135
The C<newline> accessor returns the newline format that will be used in
 
136
the localisation process.
 
137
 
 
138
=cut
 
139
 
 
140
sub newline {
 
141
        $_[0]->_self->{newline} or "\n";
 
142
}
 
143
 
 
144
 
 
145
 
 
146
 
 
147
 
 
148
#####################################################################
 
149
# Methods
 
150
 
 
151
=pod
 
152
 
 
153
=head2 localized $file
 
154
 
 
155
The C<localized> method takes an argument of a single file name or
 
156
file handle and tests it to see it is localized correctly.
 
157
 
 
158
Returns true if localized correctly, false if not, or C<undef> on error.
 
159
 
 
160
=cut
 
161
 
 
162
sub localized {
 
163
        my $self      = shift->_self;
 
164
        my $file      = (defined $_[0] and ref $_[0]) ? shift
 
165
                      : (defined $_[0] and  -f $_[0]) ? shift
 
166
                      : return undef;
 
167
        my $newline   = $self->newline;
 
168
        my $content   = File::Slurp::read_file( $file );
 
169
 
 
170
        # Create the localized version of the file
 
171
        my $localized = $content;
 
172
        $localized =~ s/(?:\015{1,2}\012|\015|\012)/$newline/sg;
 
173
 
 
174
        $localized eq $content;
 
175
}
 
176
 
 
177
=pod
 
178
 
 
179
=head2 find $dir
 
180
 
 
181
The C<find> method takes the path for a dir (or file) and returns a list
 
182
of relative files names for all of the files that do B<not> have their
 
183
newlines correctly localized.
 
184
 
 
185
Returns a list of file names, or the null list if there are no files,
 
186
or if an incorrect path was provided.
 
187
 
 
188
=cut
 
189
 
 
190
sub find {
 
191
        my $self = shift->_self;
 
192
        my $path = _DIRECTORY(shift) or return ();
 
193
 
 
194
        # Find all the files to test
 
195
        my @files = $self->Find->in( $path );
 
196
        @files = grep {
 
197
                ! $self->localized(
 
198
                        File::Spec->catfile( $path, $_ )
 
199
                        )
 
200
                } @files;
 
201
 
 
202
        @files;
 
203
}
 
204
 
 
205
=pod
 
206
 
 
207
=head2 localize $file | $dir
 
208
 
 
209
The C<localize> method takes a file, file handle or directory as argument 
 
210
and localizes the newlines of the file, or all files within the directory 
 
211
(that match the filter if one was provided).
 
212
 
 
213
Returns the number of files that were localized, zero if no files needed to
 
214
be localized, or C<undef> on error.
 
215
 
 
216
=cut
 
217
 
 
218
sub localize {
 
219
        my $self = shift->_self;
 
220
        my $path = (defined $_[0] and ref $_[0]) ? shift
 
221
                 : (defined $_[0] and  -e $_[0]) ? shift
 
222
                 : return undef;
 
223
 
 
224
        # Switch on file or dir
 
225
        (-f $path or ref $_[0])
 
226
                ? $self->_localize_file( $path )
 
227
                : $self->_localize_dir( $path );
 
228
}
 
229
 
 
230
sub _localize_dir {
 
231
        my $self = shift->_self;
 
232
        my $path = _DIRECTORY(shift) or return undef;
 
233
 
 
234
        # Find the files to localise
 
235
        my @files = $self->Find->in( $path );
 
236
 
 
237
        # Localize the files
 
238
        my $count   = 0;
 
239
        my $newline = $self->newline;
 
240
        foreach ( @files ) {
 
241
                my $file      = File::Spec->catfile( $path, $_ );
 
242
                my $content   = File::Slurp::read_file( $file );
 
243
                my $localized = $content;
 
244
                $localized =~ s/(?:\015{1,2}\012|\015|\012)/$newline/sg;
 
245
                next if $localized eq $content;
 
246
                File::Slurp::write_file( $file, $localized ) or return undef;
 
247
                $self->_message( "Localized $file\n" );
 
248
                $count++;
 
249
        }
 
250
 
 
251
        $count;
 
252
}
 
253
 
 
254
sub _localize_file {
 
255
        my $self = shift->_self;
 
256
        my $file = (defined $_[0] and ref $_[0]) ? shift
 
257
                 : (defined $_[0] and  -f $_[0]) ? shift
 
258
                 : return undef;
 
259
 
 
260
        # Does the file need to be localised
 
261
        my $newline   = $self->newline;
 
262
        my $content   = File::Slurp::read_file( $file );
 
263
        my $localized = $content;
 
264
        $localized =~ s/(?:\015{1,2}\012|\015|\012)/$newline/sg;
 
265
        return 0 if $content eq $localized;
 
266
 
 
267
        # Save the localised version
 
268
        File::Slurp::write_file( $file, $content ) or return undef;
 
269
        $self->_message( "Localized $file\n" ) unless ref $file;
 
270
 
 
271
        1;
 
272
}
 
273
 
 
274
sub _message {
 
275
        my $self = shift;
 
276
        return 1 unless defined $self->{verbose};
 
277
        my $message = shift;
 
278
        $message .= "\n" unless $message =~ /\n$/;
 
279
        if ( _CAN( $self->{verbose}, 'print' ) ) {
 
280
                $self->{verbose}->print( $message );
 
281
        } else {
 
282
                print STDOUT $message;
 
283
        }
 
284
}
 
285
 
 
286
sub _CAN {
 
287
        (_INSTANCE($_[0], 'UNIVERSAL') and $_[0]->can($_[1])) ? shift : undef;
 
288
}
 
289
 
 
290
sub _DIRECTORY {
 
291
        (defined $_[0] and -d $_[0]) ? shift : undef;
 
292
}
 
293
 
 
294
1;
 
295
 
 
296
=pod
 
297
 
 
298
=head1 SUPPORT
 
299
 
 
300
Bugs should always be submitted via the CPAN bug tracker
 
301
 
 
302
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-LocalizeNewlines>
 
303
 
 
304
For other issues, contact the maintainer.
 
305
 
 
306
=head1 AUTHOR
 
307
 
 
308
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 
309
 
 
310
=head1 ACKNOWLEDGEMENTS
 
311
 
 
312
Thank you to Phase N (L<http://phase-n.com/>) for permitting
 
313
the open sourcing and release of this distribution.
 
314
 
 
315
L<FileHandle> support added by David Dick E<lt>ddick@cpan.orgE<gt>
 
316
 
 
317
=head1 COPYRIGHT
 
318
 
 
319
Copyright 2005 - 2008 Adam Kennedy.
 
320
 
 
321
This program is free software; you can redistribute
 
322
it and/or modify it under the same terms as Perl itself.
 
323
 
 
324
The full text of the license can be found in the
 
325
LICENSE file included with this module.
 
326
 
 
327
=cut