lib/PXElator/file.pm

package file;

use File::Slurp;
use autodie;
use Carp qw/carp confess/;
use File::Path qw//;
use Data::Dump qw/dump/;

my $debug = 0;

sub mkpath {
        my $file = shift;
        my $dir = $1 if $file =~ s{(^.+)/[^/]+}{$1};
        if ( $dir && ! -d $dir ) {
                carp "# mkdir $dir";
                File::Path::mkpath $dir;
        }
}

sub append {
        my ( $file, $content ) = @_;

        if ( ! -e $file ) {
                mkpath $file;
                write_file $file, $content;
                my $size = -s $file;
                carp "## append created $size bytes in $file";
                return $size;
        }

        my $on_disk = read_file $file;

        my $relaxed_content = $content;
           $relaxed_content =~ s{\s+}{\\s+}gs;

        if ( $on_disk !~ m{$relaxed_content} ) {

#               $content =~ s{^[\n\r]+}{\n}s;
#               $content =~ s{[\n\r]*$}{\n}s;

                if ( $on_disk =~ s{([\s+]exit[\s\d]*)$}{\n$content\n$1}s ) {
                        warn "# insert $file\n$on_disk" if $debug;
                        write_file $file, $on_disk;
                } else {
                        warn "# append $file\n$content\n" if $debug;
                        open($fh, '>>', $file);
                        print $fh $content;
                        close($fh);
                }

                carp "## append to $file" if $debug;
                return -s $file;
        } else {
                warn "## $file not modified" if $debug;
        }
}

sub change {
        my ( $file, $from, $to ) = @_;

        my $content = read_file $file;
        if ( $content =~ s{$from}{$to}s ) {
                write_file $file, $content;
                carp "## change $file $from => $to" if $debug;
                return 1;
        } elsif ( $content !~ m{$to}s ) {
                confess "can't find $from to change into $to in $file in ",dump( $content );
        }
}

sub replace {
        my ( $file, $content ) = @_;
        mkpath $file;
        write_file $file, $content;
}

sub copy_once {
        my ( $from, $to ) = @_;
        die "no destination" unless $to;
        return if -e $to;
        mkpath $to;
        my $perm = (stat $from)[2];
        carp "# copy_once $from => $to $perm";
        write_file $to, read_file($from);
        chmod $perm, $to;
}

1;
1	dpavlin	271	package file;
2
3			use File::Slurp;
4			use autodie;
5			use Carp qw/carp confess/;
6			use File::Path qw//;
7	dpavlin	290	use Data::Dump qw/dump/;
8	dpavlin	271
9	dpavlin	438	my $debug = 0;
10	dpavlin	290
11	dpavlin	271	sub mkpath {
12			my $file = shift;
13	dpavlin	291	my $dir = $1 if $file =~ s{(^.+)/[^/]+}{$1};
14			if ( $dir && ! -d $dir ) {
15			carp "# mkdir $dir";
16			File::Path::mkpath $dir;
17			}
18	dpavlin	271	}
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	dpavlin	290	carp "## append created $size bytes in $file";
28	dpavlin	271	return $size;
29			}
30
31			my $on_disk = read_file $file;
32
33	dpavlin	290	my $relaxed_content = $content;
34			$relaxed_content =~ s{\s+}{\\s+}gs;
35	dpavlin	271
36			if ( $on_disk !~ m{$relaxed_content} ) {
37
38			# $content =~ s{^[\n\r]+}{\n}s;
39			# $content =~ s{[\n\r]*$}{\n}s;
40
41	dpavlin	290	if ( $on_disk =~ s{([\s+]exit[\s\d]*)$}{\n$content\n$1}s ) {
42	dpavlin	438	warn "# insert $file\n$on_disk" if $debug;
43	dpavlin	290	write_file $file, $on_disk;
44			} else {
45	dpavlin	438	warn "# append $file\n$content\n" if $debug;
46	dpavlin	290	open($fh, '>>', $file);
47			print $fh $content;
48			close($fh);
49			}
50	dpavlin	271
51	dpavlin	438	carp "## append to $file" if $debug;
52	dpavlin	290	return -s $file;
53	dpavlin	438	} else {
54			warn "## $file not modified" if $debug;
55	dpavlin	271	}
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	dpavlin	290	carp "## change $file $from => $to" if $debug;
65	dpavlin	271	return 1;
66			} elsif ( $content !~ m{$to}s ) {
67	dpavlin	290	confess "can't find $from to change into $to in $file in ",dump( $content );
68	dpavlin	271	}
69			}
70
71	dpavlin	277	sub replace {
72			my ( $file, $content ) = @_;
73			mkpath $file;
74			write_file $file, $content;
75			}
76	dpavlin	271
77	dpavlin	290	sub copy_once {
78			my ( $from, $to ) = @_;
79	dpavlin	291	die "no destination" unless $to;
80	dpavlin	290	return if -e $to;
81			mkpath $to;
82	dpavlin	292	my $perm = (stat $from)[2];
83			carp "# copy_once $from => $to $perm";
84	dpavlin	291	write_file $to, read_file($from);
85	dpavlin	292	chmod $perm, $to;
86	dpavlin	290	}
87
88	dpavlin	271	1;