package Setup::File::Symlink;
BEGIN {
  $Setup::File::Symlink::VERSION = '0.07';
}
# ABSTRACT: Ensure symlink existence and target

use 5.010;
use strict;
use warnings;
use Log::Any '$log';

use Data::Dump::Partial qw(dumpp);
use File::Copy::Recursive qw(rmove);
use File::Path qw(remove_tree);
use UUID::Random;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(setup_symlink);

our %SPEC;

$SPEC{setup_symlink} = {
    summary  => "Create symlink or fix symlink target",
    description => <<'_',

On do, will create symlink which points to specified target. If symlink already
exists but points to another target, it will be replaced with the correct
symlink if replace_symlink option is true. If a file already exists, it will be
removed (or, backed up to temporary directory) before the symlink is created, if
replace_file option is true.

If given, -undo_hint should contain {tmp_dir=>...} to specify temporary
directory to save replaced file/dir. Temporary directory defaults to ~/.setup,
it will be created if not exists.

On undo, will restore the original symlink/ if it was replaced during do.

_
    args     => {
        symlink => ['str*' => {
            summary => 'Path to symlink',
            description => <<'_',

Symlink path needs to be absolute so it's normalized.

_
            arg_pos => 1,
            match   => qr!^/!,
        }],
        target => ['str*' => {
            summary => 'Target path of symlink',
            arg_pos => 0,
        }],
        create => ['bool*' => {
            summary => "Create if symlink doesn't exist",
            default => 1,
            description => <<'_',

If set to false, then setup will fail (412) if this condition is encountered.

_
        }],
        replace_symlink => ['bool*' => {
            summary => "Replace previous symlink if it already exists ".
                "but doesn't point to the wanted target",
            description => <<'_',

If set to false, then setup will fail (412) if this condition is encountered.

_
            default => 1,
        }],
        replace_file => ['bool*' => {
            summary => "Replace if there is existing non-symlink file",
            description => <<'_',

If set to false, then setup will fail (412) if this condition is encountered.

_
            default => 0,
        }],
        replace_dir => ['bool*' => {
            summary => "Replace if there is existing dir",
            description => <<'_',

If set to false, then setup will fail (412) if this condition is encountered.

_
            default => 0,
        }],
    },
    features => {undo=>1, dry_run=>1},
};
sub setup_symlink {
    my %args        = @_;
    my $dry_run     = $args{-dry_run};
    my $undo_action = $args{-undo_action} // "";

    # check args
    my $symlink     = $args{symlink};
    $symlink =~ m!^/!
        or return [400, "Please specify an absolute path for symlink"];
    my $target  = $args{target};
    defined($target) or return [400, "Please specify target"];
    my $create       = $args{create} // 1;
    my $replace_file = $args{replace_file} // 0;
    my $replace_dir  = $args{replace_dir} // 0;
    my $replace_sym  = $args{replace_symlink} // 1;

    # check current state and collect steps
    my $is_symlink = (-l $symlink); # -l performs lstat()
    my $exists     = (-e _);        # now we can use -e
    my $is_dir     = (-d _);
    my $cur_target = $is_symlink ? readlink($symlink) : "";
    my $steps;
    if ($undo_action eq 'undo') {
        $steps = $args{-undo_data} or return [400, "Please supply -undo_data"];
    } elsif ($undo_action eq 'redo') {
        $steps = $args{-redo_data} or return [400, "Please supply -redo_data"];
    } else {
        $steps = [];
        if ($exists && !$is_symlink) {
            $log->tracef("nok: exist but not a symlink");
            if ($is_dir) {
                if (!$replace_dir) {
                    return [412, "must replace dir but instructed not to"];
                }
                push @$steps, ["rm"], ["ln"];
            } else {
                if (!$replace_file) {
                    return [412, "must replace file but instructed not to"];
                }
                push @$steps, ["rm"], ["ln"];
            }
        } elsif ($is_symlink && $cur_target ne $target) {
            $log->tracef("nok: symlink doesn't point to correct target");
            if (!$replace_sym) {
                return [412, "must replace symlink but instructed not to"];
            }
            push @$steps, ["rmsym"], ["ln"];
        } elsif (!$exists) {
            $log->tracef("nok: doesn't exist");
            if (!$create) {
                return [412, "must create symlink but instructed not to"];
            }
            push @$steps, ["ln"];
        }
    }

    return [400, "Invalid steps, must be an array"]
        unless $steps && ref($steps) eq 'ARRAY';

    return [200, "Dry run"] if $dry_run;

    # create tmp dir for undo
    my $save_undo    = $undo_action ? 1:0;
    my $undo_hint = $args{-undo_hint} // {};
    return [400, "Invalid -undo_hint, please supply a hashref"]
        unless ref($undo_hint) eq 'HASH';
    my $tmp_dir = $undo_hint->{tmp_dir} // "$ENV{HOME}/.setup";
    if ($save_undo && !(-d $tmp_dir)) {
        mkdir $tmp_dir or return [500, "Can't make temp dir `$tmp_dir`: $!"];
    }
    my $save_path = "$tmp_dir/".UUID::Random::generate;

    # perform the steps
    my $is_rollback;
    my $undo_steps = [];
  STEPS:
    for my $i (0..@$steps-1) {
        my $step = $steps->[$i];
        $log->tracef("step %d of 0..%d: %s", $i, @$steps-1, $step);
        my $err;
        return [400, "Invalid step (not array)"] unless ref($step) eq 'ARRAY';
        if ($step->[0] eq 'rmsym') {
            if ($exists) {
                if (unlink $symlink) {
                    unshift @$undo_steps, ["ln", $cur_target];
                } else {
                    $err = "Can't remove $symlink: $!";
                }
            }
        } elsif ($step->[0] eq 'rm') {
            if ($exists) {
                # do not bother to save file/dir if not asked
                if ($save_undo) {
                    if (rmove $symlink, $save_path) {
                        unshift @$undo_steps, ["restore", $save_path];
                    } elsif ((-l $symlink) || (-e _)) {
                        $err = "Can't move file/dir $symlink -> $save_path: $!";
                    }
                } else {
                    remove_tree($symlink, {error=>\my $e});
                    if (@$e && ((-l $symlink) || (-e _))) {
                        $err = "Can't remove file/dir $symlink: ".dumpp($e);
                    }
                }
            }
        } elsif ($step->[0] eq 'restore') {
            if (rmove $step->[1], $symlink) {
                unshift @$undo_steps, ["rm"];
            } else {
                $err = "Can't restore $step->[1] -> $symlink: $!";
            }
        } elsif ($step->[0] eq 'ln') {
            my $t = $step->[1] // $target;
            unless ((-l $symlink) && readlink($symlink) eq $t) {
                if (symlink $t, $symlink) {
                    unshift @$undo_steps, ["rmsym"];
                } else {
                    $err = "Can't symlink $symlink -> $target: $!";
                }
            }
        } else {
            die "BUG: Unknown step command: $step->[0]";
        }
        if ($err) {
            if ($is_rollback) {
                die "Failed rollback step $i of 0..".(@$steps-1).": $err";
            } else {
                $log->tracef("Step failed: $err, performing rollback ...");
                $is_rollback++;
                $steps = $undo_steps;
                redo STEPS;
            }
        }
    }

    my $meta = {};
    if ($undo_action =~ /^(re)?do$/) { $meta->{undo_data} = $undo_steps }
    elsif ($undo_action eq 'undo')   { $meta->{redo_data} = $undo_steps }
    return [@$steps ? 200 : 304,
            @$steps ? "OK" : "Nothing done",
            undef,
            $meta];
}

1;


=pod

=head1 NAME

Setup::File::Symlink - Ensure symlink existence and target

=head1 VERSION

version 0.07

=head1 SYNOPSIS

 use Setup::File::Symlink 'setup_symlink';

 # simple usage (doesn't save undo data)
 my $res = setup_symlink symlink => "/baz", target => "/qux";
 die unless $res->[0] == 200 || $res->[0] == 304;

 # perform setup and save undo data
 my $res = setup_symlink symlink => "/foo", target => "/bar",
                         -undo_action => 'do';
 die unless $res->[0] == 200 || $res->[0] == 304;
 my $undo_data = $res->[3]{undo_data};

 # perform undo
 my $res = setup_symlink symlink => "/symlink", target=>"/target",
                         -undo_action => "undo", -undo_data=>$undo_data;
 die unless $res->[0] == 200;
 my $redo_data = $res->[3]{redo_data};

 # perform redo
 my $res = setup_symlink symlink => "/symlink", target=>"/target",
                         -undo_action => "redo", -redo_data=>$redo_data;
 die unless $res->[0] == 200;

=head1 DESCRIPTION

This module provides one function B<setup_symlink>.

This module is part of the Setup modules family.

This module uses L<Log::Any> logging framework.

This module's functions have L<Sub::Spec> specs.

=head1 THE SETUP MODULES FAMILY

I use the C<Setup::> namespace for the Setup modules family, typically used in
installers (or other applications). The modules in Setup family have these
characteristics:

=over 4

=item * used to reach some desired state

For example, Setup::File::Symlink::setup_symlink makes sure a symlink exists to
the desired target. Setup::File::setup_file makes sure a file exists with the
correct content/ownership/permission.

=item * do nothing if desired state has been reached

Function should return 304 (nothing to do) status.

=item * support dry-run (simulation) mode

Function should return 200 on success, but change nothing.

=item * support undo to restore state to previous/original one

=back

=head1 FUNCTIONS

None are exported by default, but they are exportable.

=head2 setup_symlink(%args) -> [STATUS_CODE, ERR_MSG, RESULT]


Create symlink or fix symlink target.

On do, will create symlink which points to specified target. If symlink already
exists but points to another target, it will be replaced with the correct
symlink if replace_symlink option is true. If a file already exists, it will be
removed (or, backed up to temporary directory) before the symlink is created, if
replace_file option is true.

If given, -undo_hint should contain {tmp_dir=>...} to specify temporary
directory to save replaced file/dir. Temporary directory defaults to ~/.setup,
it will be created if not exists.

On undo, will restore the original symlink/ if it was replaced during do.

Returns a 3-element arrayref. STATUS_CODE is 200 on success, or an error code
between 3xx-5xx (just like in HTTP). ERR_MSG is a string containing error
message, RESULT is the actual result.

This function supports undo operation. See L<Sub::Spec::Clause::features> for
details on how to perform do/undo/redo.

This function supports dry-run (simulation) mode. To run in dry-run mode, add
argument C<-dry_run> => 1.

Arguments (C<*> denotes required arguments):

=over 4

=item * B<target>* => I<str>

Target path of symlink.

=item * B<symlink>* => I<str>

Path to symlink.

Symlink path needs to be absolute so it's normalized.

=item * B<create>* => I<bool> (default C<1>)

Create if symlink doesn't exist.

If set to false, then setup will fail (412) if this condition is encountered.

=item * B<replace_dir>* => I<bool> (default C<0>)

Replace if there is existing dir.

If set to false, then setup will fail (412) if this condition is encountered.

=item * B<replace_file>* => I<bool> (default C<0>)

Replace if there is existing non-symlink file.

If set to false, then setup will fail (412) if this condition is encountered.

=item * B<replace_symlink>* => I<bool> (default C<1>)

Replace previous symlink if it already exists but doesn't point to the wanted target.

If set to false, then setup will fail (412) if this condition is encountered.

=back

=head1 SEE ALSO

L<Sub::Spec>, specifically L<Sub::Spec::Clause::features> on dry-run/undo.

Other modules in Setup:: namespace.

=head1 AUTHOR

Steven Haryanto <stevenharyanto@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Steven Haryanto.

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


__END__