App-WordPressTools

 view release on metacpan or  search on metacpan

script/wp-tools  view on Meta::CPAN

    help(1, "Required parameter missing");
}

if (!$ENV{WP_TOOLS_SILENCE_DEPRECATION_WARNINGS}) {
    # print warnings for deprecated args
    for my $arg (qw{path backup_dir backup_file}) {
        next if !$args->{$arg} || $args->{$arg} =~ m!^/!;
        warn "DEPRECATED use of relative path ($args->{$arg}); use \$PWD/$args->{$arg} instead!\n";
    }
}

### check box load
if ($args->{max_load} && !$args->{force}) {
    open(my $fh, '<', '/proc/loadavg');
    my $loadfile = readline $fh;
    close $fh;
    my ($load) = $loadfile =~ /^(\S+)/;
    if (int($load) > $args->{max_load}) {
        die "Server load is too high ($load), please retry later.";
    }
}

### check box memory usage
if ($args->{min_freemem} && !$args->{force}) {
    my $mem = read_text(q{/proc/meminfo});
    my $free;
    for my $memcheck (qw(MemFree SwapFree Buffers Cached)) {
        ($free->{$memcheck}) = $mem =~ m/^$memcheck:*\s*(\d+)/gsm;
        $free->{$memcheck} ||= 0;
    }
    if (($free->{'Buffers'} + $free->{'Cached'} + $free->{'MemFree'}) < $args->{'min_freemem'}) {
        die "Insufficient available server memory (bcm), please retry later";
    }
    my $swapon = `swapon -s | wc -l`;
    chomp $swapon;
    $swapon--;
    if ($swapon && $free->{'SwapFree'} < $args->{'min_freemem'}) {
        die "Insufficient available server memory (s), please retry later";
    }
}

### check defunct process count
if ($args->{max_dproc} && !$args->{force}) {
    #my $dproc = `ps -o state | grep D | wc -l`;
    my $dproc = `awk '/procs_blocked/ {print \$2}' /proc/stat`;
    if ($dproc > $args->{'max_dproc'}) {
        die 'Process queue full, please try again later.';
    }
}

my ($uid, $gid, $home_dir);
### determine who we are or should be running as
if ($< == 0) {
    if (!$args->{'username'}) {
        help(1, "You cannot $command a WordPress installation as a root user");
    }
    ($uid, $gid, $home_dir) = (getpwnam $args->{'username'})[2, 3, 7];
}
else {
    my $username;
    ($username, $uid, $gid, $home_dir) = (getpwuid $<)[0, 2, 3, 7];
    $args->{'username'} = $username if !$args->{'username'};
}

### check space and average IO wait time of the home partition
if (my ($homeslash) = $home_dir =~ m{^(/home\d+)/} and !$args->{force}) {
    #get available space on /home for the user in question in POSIX standard
    my $df = `df -P $homeslash | tail -1`;
    my ($device,undef,undef,$available) = split(/\s+/, $df);
    #convert to MB
    my $mbavail  = $available / 1024;
    die "Not enough space available for backup ($mbavail MB)" if $mbavail < $args->{'min_space'};
    if ($args->{max_await} && $device !~ /^(?:rootfs|fakefs)/) {
        my $iostat = `iostat $device -dx 10 2 | tail -2`;
        chomp $iostat;
        my @iostat = split(/\s+/, $iostat);
        my $await = $iostat[9];
        if (!$await || $await !~ /^[0-9.]+$/) {
            warn "ignoring that await is not a number ($await)";
            $await = 0;
        }
        die "Average IO wait time ($await) is too high on $homeslash" if $args->{'max_await'} < $await;
    }
}

### drop permissions
if ($< == 0) {
    #dmother
    #added use English; equivalent statements for clarity
    #keeping punctuation variables for speed
    #$REAL_GROUP_ID = $EFFECTIVE_GROUP_ID = "$gid $gid";
    $( = $) = "$gid $gid";
    #$REAL_USER_ID = $EFFECTIVE_USER_ID = $uid;
    $< = $> = $uid;
    #cannot perform this action as root
    if ($< == 0) {
        die "Failed to relinquish privileges to user $args->{'username'}: $!";
    }
}
chdir($home_dir);

### prevent too many concurrent executions
our %pid_files;
sub create_pid_file {
    my $file = shift;
    return $pid_files{$file} if $pid_files{$file};
    sysopen(my $fh, $file, O_RDWR|O_CREAT) or die "Open pid file failed: $!";
    flock($fh, LOCK_EX|LOCK_NB) or die "Locking pid file ($file) failed: $!";
    chmod(0666, $file);     # explicitly ignore chmod errors since we may not be the owner
    print $fh "$$\n";
    return $pid_files{$file} = $fh;
}
sub unlink_pid_file {
    my $file = shift;
    my $fh   = $pid_files{$file} or return;
    close($fh);
    unlink($file);      # explicitly ignore unlink errors since we may not be the owner
}
for my $i (1..$args->{max_run}) {
    my $num  = sprintf('%04d', $i);
    my $file = "/tmp/wp_backup-${num}.pid";



( run in 0.709 second using v1.01-cache-2.11-cpan-39bf76dae61 )