view release on metacpan or  search on metacpan

lib/App/DistSync.pm  view on Meta::CPAN

    /;

use constant {
    TEMPFILE    => sprintf("distsync_%s.tmp", $$),
    TIMEOUT     => 30,
    METAFILE    => 'META',
    MANIFEST    => 'MANIFEST',
    MANISKIP    => 'MANIFEST.SKIP',
    MANITEMP    => 'MANIFEST.TEMP',
    MANILOCK    => 'MANIFEST.LOCK',
    MANIDEL     => 'MANIFEST.DEL',
    MIRRORS     => 'MIRRORS',
    README      => 'README',
    SKIPFILES   => [qw/
        META MANIFEST MIRRORS README
        MANIFEST.SKIP MANIFEST.LOCK MANIFEST.TEMP MANIFEST.DEL
    /],
    SKIPMODE    => 1,
    LIMIT       => '+1m', # '+1m' Limit gt and lt
    EXPIRE      => '+3d', # '+3d' For deleting
    FREEZE      => '+1d', # '+1d' For META test
};

# Methods
sub new {
    my $class = shift;
    my %props = @_;

    # Check directory
    my $dir = $props{dir} // getcwd();
    croak("Directory '$dir' not exists") unless length($dir) && (-d $dir or -l $dir);
    $props{dir} = $dir = abs_path($dir);

    # General
    $props{started} = $props{stamp} = time;
    $props{pid} ||= $$;
    $props{timeout} //= TIMEOUT;
    $props{verbose} ||= 0;
    $props{insecure} ||= 0;
    $props{proxy} //= '';
    $props{url} = '';
    $props{hostname} = hostname();

    # Files
    $props{file_meta}       = File::Spec->catfile($dir, METAFILE);
    $props{file_manifest}   = File::Spec->catfile($dir, MANIFEST);
    $props{file_maniskip}   = File::Spec->catfile($dir, MANISKIP);
    $props{file_manilock}   = File::Spec->catfile($dir, MANILOCK);
    $props{file_manitemp}   = File::Spec->catfile($dir, MANITEMP);
    $props{file_manidel}    = File::Spec->catfile($dir, MANIDEL);
    $props{file_mirrors}    = File::Spec->catfile($dir, MIRRORS);
    $props{file_readme}     = File::Spec->catfile($dir, README);
    $props{file_temp}       = File::Spec->catfile(File::Spec->tmpdir(), TEMPFILE);

    # Read META file as YAML
    my $meta = read_yaml($props{file_meta});
    $props{meta} = $meta;

    # Create current static dates
    $props{mtime_manifest} = (-e $props{file_manifest}) && -s $props{file_manifest}
        ? (stat($props{file_manifest}))[9]
        : 0;
    $props{mtime_manidel}  = (-e $props{file_manidel}) && -s $props{file_manidel}
        ? (stat($props{file_manidel}))[9]
        : 0;
    $props{mtime_mirrors}  = (-e $props{file_mirrors}) && -s $props{file_mirrors}
        ? (stat($props{file_mirrors}))[9]
        : 0;

    # Set TimeOut
    my $to = _expire($props{timeout} // TIMEOUT);
    croak("Can't use specified timeout") unless $to =~ /^[0-9]{1,11}$/;

    # Instance
    my $self = bless({%props}, $class);

    # User Agent
    my $ua = $self->{ua} = LWP::UserAgent->new();
    $ua->timeout($to) if $to;
    $ua->agent(sprintf("%s/%s", __PACKAGE__, $VERSION));
    $ua->env_proxy;
    $ua->proxy(['http', 'https'] => $props{proxy}) if $props{proxy};
    $ua->ssl_opts(
        verify_hostname => 0,
        SSL_verify_mode => 0x00
    ) if $props{insecure};

    return $self;
}
sub verbose { !!shift->{verbose} }
sub dir { shift->{dir} }
sub pid { shift->{pid} }
sub ua { shift->{ua} }
sub init { # Initialization
    my $self = shift;
    my $stamp = scalar(localtime($self->{started}));
    my $status = 1;

    # MANIFEST.SKIP
    printf "%s... ", $self->{file_maniskip};
    if (touch($self->{file_maniskip}) && (-e $self->{file_maniskip}) && -z $self->{file_maniskip}) {
        my @content = (
            "# Generated on $stamp",
            "# List of files that should not be synchronized",
            "#",
            "# Format of file:",
            "#",
            "# dir1/dir2/.../dirn/foo.txt        any comment, for example blah-blah-blah",
            "# bar.txt                           any comment, for example blah-blah-blah",
            "# baz.txt",
            "# 'spaced dir1/foo.txt'             any comment, for example blah-blah-blah",
            "# 'spaced dir1/foo.txt'             any comment, for example blah-blah-blah",
            "# !!perl/regexp (?i-xsm:\\.bak\$)     avoid all bak files",
            "#",
            "# See also MANIFEST.SKIP file of ExtUtils::Manifest v1.68 or later",
            "#",
            "",
            "# Avoid version control files.",
            "!!perl/regexp (?i-xsm:\\bRCS\\b)",
            "!!perl/regexp (?i-xsm:\\bCVS\\b)",
            "!!perl/regexp (?i-xsm:\\bSCCS\\b)",
            "!!perl/regexp (?i-xsm:,v\$)",
            "!!perl/regexp (?i-xsm:\\B\\.svn\\b)",
            "!!perl/regexp (?i-xsm:\\B\\.git\\b)",
            "!!perl/regexp (?i-xsm:\\B\\.gitignore\\b)",
            "!!perl/regexp (?i-xsm:\\b_darcs\\b)",
            "!!perl/regexp (?i-xsm:\\B\\.cvsignore\$)",