The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package main;

use strict;
use warnings;

use Mac::Pasteboard qw{:all};
use Test::More 0.88;

sub mytest (@);	## no critic (ProhibitSubroutinePrototypes)

{
    Mac::Pasteboard->set( fatal => 0 );
    Mac::Pasteboard->new();
    if (Mac::Pasteboard->get( 'status' ) == coreFoundationUnknownErr()) {
	plan skip_all => 'No access to desktop (maybe running as ssh session or cron job?)';
	exit;
    }
    Mac::Pasteboard->set( fatal => 1 );
}

my $pbopt;
foreach my $args (
    [], ['general', undef, undef, kPasteboardClipboard],
    ['find', 'pbcopy_find', 'pbpaste_find', kPasteboardFind]
) {
    ($pbopt, my $putter, my $getter, my @args) = @$args;
    $pbopt = $pbopt ? "-pbopt $pbopt" : '';
    my $putsub = __PACKAGE__->can ($putter ||= 'pbcopy');
    my $getsub = __PACKAGE__->can ($getter ||= 'pbpaste');

    my $where = $args[0] || 'the default pasteboard';

    my $pb = Mac::Pasteboard->new(@args);

    $pb->clear();
    my $data = '    She set out one day';
    $pb->copy ($data);
    mytest scalar $pb->paste(), $data,
	"Retrieve data placed on $where with copy.";

    $data = '    In a relative way';
    $putsub->($data);
    mytest scalar $pb->paste(), $data,
	"Retrieve data placed on $where with $putter.";

    $data = 'And returned the previous night.';
    $pb->clear();
    $pb->copy ($data);
    mytest scalar $getsub->(), $data, "Retrieve data from $where with $getter.";
}

done_testing;

sub mytest (@) {	## no critic (ProhibitSubroutinePrototypes, RequireArgUnpacking)
    my $got = shift;
    my $want = shift;
    my ($ext_got, $ext_want);
    ($got, $ext_got) = groom ($got);
    ($want, $ext_want) = groom ($want);
    my $ref = ref $want;
    if ($ref eq 'Regexp') {
	@_ = ( $got, $want, "@_" );
	goto &like;
    } elsif (defined $want) {
	@_ = ( $got, $want, "@_" );
	goto &is;
    } else {
	@_ = ( ! defined $got, "@_" );
	goto &ok;
    }
}

sub groom {
    my $data = shift;
    if (!defined $data) {
	return ($data, 'undef');
    } elsif (!ref $data) {
	chomp $data;
	return ($data, "'$data'");
    } else {
	return ($data, $data);
    }
}

1;