File: Deploy.pm

package info (click to toggle)
libhtml-formfu-perl 0.09007-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 4,184 kB
  • sloc: perl: 13,186; makefile: 9; sql: 5
file content (109 lines) | stat: -rw-r--r-- 2,509 bytes parent folder | download
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
package HTML::FormFu::Deploy;

use strict;

use HTML::FormFu::Constants qw( $EMPTY_STR );
use Cwd qw( getcwd );
use Fatal qw( open binmode close mkdir );
use File::Copy qw( copy 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";

    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;