The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

CFRANKS / HTML-FormFu-2.07 / lib / HTML / FormFu / Deploy.pm 

            

              
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

              
use strict;
package HTML::FormFu::Deploy;
# ABSTRACT: deploy project
$HTML::FormFu::Deploy::VERSION = '2.07';
use warnings;
use HTML::FormFu::Constants qw( $EMPTY_STR );
use Cwd qw( getcwd );
use Fatal qw( open binmode close mkdir );
use File::Copy qw( move );
use File::Find qw( find );
use File::ShareDir qw( dist_file );
use File::Spec;
use Carp qw( croak );
our $SHARE_DIR;
if ( -f 'MANIFEST.SKIP' && -d 'share/templates/tt/xhtml' ) {
    warn "Running as a developer, using the local, not installed templates\n\n"
        unless ( $ENV{HARNESS_ACTIVE} );
    my $cwd = getcwd();
    $SHARE_DIR = File::Spec->catfile( $cwd, 'share/templates/tt/xhtml' );
}
else {
    # dist_dir() doesn't reliably return the directory our files are in.
    # find the path of one of our files, then get the directory from that
    my $path = dist_file( 'HTML-FormFu', 'templates/tt/xhtml/form' );
    my ( $volume, $dirs, $file ) = File::Spec->splitpath($path);
    $SHARE_DIR = File::Spec->catpath( $volume, $dirs, '' );
}
sub file_list {
    my @dir;
    my $wanted = sub {
        return if /^\./;                    # skip files beginning with "."
        return if !-f $File::Find::name;    # skip non-files
        # necessary when using dev files
        return if $File::Find::name =~ m|/\.svn|;
        push @dir, $_;
    };
    find( $wanted, $SHARE_DIR );
    return @dir;
}
sub file_source {
    my $filename = shift
        or croak "filename argument required";
    my $path = File::Spec->catfile( $SHARE_DIR, $filename );
    croak "unknown filename: '$path'" if !-f $path;
    open my $fh, '<', $path;
    my $data = do { local $/; <$fh> };
    $data = $EMPTY_STR if !defined $data;
    close $fh;
    return $data;
}
sub deploy {
    my ($dir) = @_;
    croak "directory argument required" if !defined $dir;
    if ( !-d $dir ) {
        warn "creating directory '$dir'\n";
        mkdir $dir;
    }
    for my $filename ( file_list() ) {
        my $path = File::Spec->catfile( $dir, $filename );
        if ( -f $path ) {
            my $bck = $path . ".bck";
            warn "file '$path' already exists, backing up to $bck\n";
            my $ok = move( $path, $bck );
            if ( !$ok ) {
                warn "failed to backup, skipping file\n$@\n";
                next;
            }
        }
        my $fh;
        eval { open $fh, '>', $path };
        if ($@) {
            warn "failed to open '$path' for writing, skipping file\n$@\n";
            next;
        }
        binmode $fh;
        print $fh file_source($filename);
        close $fh;
    }
    return;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
HTML::FormFu::Deploy - deploy project
=head1 VERSION
version 2.07
=head1 AUTHOR
Carl Franks <cpan@fireartist.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 by Carl Franks.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut