/[pxelator]/lib/PXElator/file.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 /lib/PXElator/file.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 438 - (show annotations)
Sun Sep 20 16:11:16 2009 UTC (14 years, 7 months ago) by dpavlin
File size: 1755 byte(s)
fix non-debug verbosity
1 package file;
2
3 use File::Slurp;
4 use autodie;
5 use Carp qw/carp confess/;
6 use File::Path qw//;
7 use Data::Dump qw/dump/;
8
9 my $debug = 0;
10
11 sub mkpath {
12 my $file = shift;
13 my $dir = $1 if $file =~ s{(^.+)/[^/]+}{$1};
14 if ( $dir && ! -d $dir ) {
15 carp "# mkdir $dir";
16 File::Path::mkpath $dir;
17 }
18 }
19
20 sub append {
21 my ( $file, $content ) = @_;
22
23 if ( ! -e $file ) {
24 mkpath $file;
25 write_file $file, $content;
26 my $size = -s $file;
27 carp "## append created $size bytes in $file";
28 return $size;
29 }
30
31 my $on_disk = read_file $file;
32
33 my $relaxed_content = $content;
34 $relaxed_content =~ s{\s+}{\\s+}gs;
35
36 if ( $on_disk !~ m{$relaxed_content} ) {
37
38 # $content =~ s{^[\n\r]+}{\n}s;
39 # $content =~ s{[\n\r]*$}{\n}s;
40
41 if ( $on_disk =~ s{([\s+]exit[\s\d]*)$}{\n$content\n$1}s ) {
42 warn "# insert $file\n$on_disk" if $debug;
43 write_file $file, $on_disk;
44 } else {
45 warn "# append $file\n$content\n" if $debug;
46 open($fh, '>>', $file);
47 print $fh $content;
48 close($fh);
49 }
50
51 carp "## append to $file" if $debug;
52 return -s $file;
53 } else {
54 warn "## $file not modified" if $debug;
55 }
56 }
57
58 sub change {
59 my ( $file, $from, $to ) = @_;
60
61 my $content = read_file $file;
62 if ( $content =~ s{$from}{$to}s ) {
63 write_file $file, $content;
64 carp "## change $file $from => $to" if $debug;
65 return 1;
66 } elsif ( $content !~ m{$to}s ) {
67 confess "can't find $from to change into $to in $file in ",dump( $content );
68 }
69 }
70
71 sub replace {
72 my ( $file, $content ) = @_;
73 mkpath $file;
74 write_file $file, $content;
75 }
76
77 sub copy_once {
78 my ( $from, $to ) = @_;
79 die "no destination" unless $to;
80 return if -e $to;
81 mkpath $to;
82 my $perm = (stat $from)[2];
83 carp "# copy_once $from => $to $perm";
84 write_file $to, read_file($from);
85 chmod $perm, $to;
86 }
87
88 1;

  ViewVC Help
Powered by ViewVC 1.1.26