view release on metacpan or  search on metacpan

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

package App::tmclean;
use 5.010;
use warnings;

use version 0.77; our $VERSION = version->declare("v0.0.4");

use Getopt::Long qw/GetOptions :config posix_default no_ignore_case bundling auto_help/;
use Pod::Usage qw/pod2usage/;
use Class::Accessor::Lite (
    new => 1,
    ro  => [qw/before days dry_run/],
);
use HTTP::Date qw/str2time/;
use Time::Piece ();
use Time::Seconds ();

sub logf {
    my $msg = shift;
       $msg = sprintf($msg, @_);
    my $prefix = '[tmclean]' . Time::Piece->localtime->strftime('[%Y-%m-%d %H:%M:%S] ');
    $msg .= "\n" if $msg !~ /\n$/;
    print STDERR $prefix . $msg;
}

sub new_with_options {
    my ($class, @argv) = @_;

    my ($opt) = $class->parse_options(@argv);
    $class->new($opt);
}

sub parse_options {
    my ($class, @argv) = @_;

    local @ARGV = @argv;
    GetOptions(\my %opt, qw/
        days=i
        before=s
        dry-run
    /) or pod2usage(2);

    $opt{dry_run} = delete $opt{'dry-run'};
    return (\%opt, \@ARGV);
}

sub run {
    my $self = shift;

    if (!$self->dry_run && $ENV{USER} ne 'root') {
        die "tmutil requires root privileges\n";
    }
    $self->cmd(qw/tmutil stopbackup/);
    $self->cmd(qw/tmutil disable/); # need sudo

    my @targets = $self->backups2delete;
    unless (@targets) {
        logf 'no deletion targets found';
        return 0;
    }
    my $mount_point = $self->mount_point;

    logf "following backups to be deleted:\n  %s", join("\n  ", @targets);
    for my $bak (@targets) {
        $self->cmd(qw/tmutil delete/, $bak); # need sudo
    }
    my $dev_name = dev_name($targets[0]);
    $self->cmd(qw/hdiutil detach/, $dev_name);

    my $backupbundle_path = sprintf '%s/%s.sparsebundle', $mount_point, $self->machine_name;
    if (! -d $backupbundle_path) {
        # backupbundle path is changed after Catalina
        $backupbundle_path =~ s/\.sparsebundle$/.backupbundle/;
    }
    $self->cmd(qw/hdiutil compact/, $backupbundle_path); # need sudo
    $self->cmd(qw/tmutil enable/); # need sudo
}

sub backups2delete {
    my $self = shift;
    my @backups = `tmutil listbackups`;
    if ($? != 0) {
        die "failed to execute `tmutil listbackups`: $?\n";
    }
    # e.g. /Volumes/Time Machine Backup/Backups.backupdb/$machine/2018-01-07-033608
    return grep {
        chomp;
        my @paths = split m!/!, $_;
        my $backup_date = eval { Time::Piece->strptime($paths[-1], '%Y-%m-%d-%H%M%S') };
        $backup_date && $self->before_tp > $backup_date;
    } @backups;
}

sub mount_point {
    my $self = shift;