The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;
use warnings;
use 5.010;
use utf8;
use Test::More tests => 27;
#use Test::More 'no_plan';
use Test::NoWarnings;
use Path::Class;
use App::Sqitch;
use App::Sqitch::Plan;
use Test::MockModule;
use Digest::SHA1;
use URI;

my $CLASS;

BEGIN {
    $CLASS = 'App::Sqitch::Plan::Tag';
    require_ok $CLASS or die;
    delete $ENV{PGDATABASE};
    delete $ENV{PGUSER};
    delete $ENV{USER};
    $ENV{SQITCH_CONFIG} = 'nonexistent.conf';
}

can_ok $CLASS, qw(
    name
    info
    id
    old_info
    old_id
    lspace
    rspace
    note
    plan
    timestamp
    planner_name
    planner_email
    format_planner
);

my $sqitch = App::Sqitch->new( top_dir => dir qw(t sql) );
my $plan   = App::Sqitch::Plan->new(sqitch => $sqitch);
my $change = App::Sqitch::Plan::Change->new( plan => $plan, name => 'roles' );

isa_ok my $tag = $CLASS->new(
    name  => 'foo',
    plan  => $plan,
    change  => $change,
), $CLASS;
isa_ok $tag, 'App::Sqitch::Plan::Line';
my $mock_plan = Test::MockModule->new('App::Sqitch::Plan');
$mock_plan->mock(index_of => 0); # no other changes

is $tag->format_name, '@foo', 'Name should format as "@foo"';
isa_ok $tag->timestamp, 'App::Sqitch::DateTime', 'Timestamp';

is $tag->planner_name, $sqitch->user_name,
    'Planner name shoudld default to user name';
is $tag->planner_email, $sqitch->user_email,
    'Planner email shoudld default to user email';
is $tag->format_planner, join(
    ' ',
    $sqitch->user_name,
    '<' . $sqitch->user_email . '>'
), 'Planner name and email should format properly';

my $ts = $tag->timestamp->as_string;
is $tag->as_string, "\@foo $ts ". $tag->format_planner,
    'Should as_string to "@foo" + timstamp + planner';
my $uri = URI->new('https://github.com/theory/sqitch/');
$mock_plan->mock( uri => $uri );
is $tag->info, join("\n",
    'project sql',
    'uri https://github.com/theory/sqitch/',
    'tag @foo',
    'change ' . $change->id,
    'planner ' . $tag->format_planner,
    'date '    . $ts,
), 'Tag info should incldue the URI';

is $tag->old_info, join("\n",
    'project sql',
    'uri https://github.com/theory/sqitch/',
    'tag @foo',
    'change ' . $change->old_id,
    'planner ' . $tag->format_planner,
    'date '    . $ts,
), 'Old tag info should incldue the URI';

my $date = App::Sqitch::DateTime->new(
    year   => 2012,
    month  => 7,
    day    => 16,
    hour   => 17,
    minute => 25,
    second => 7,
    time_zone => 'UTC',
);

ok $tag = $CLASS->new(
    name          => 'howdy',
    plan          => $plan,
    change        => $change,
    lspace        => '  ',
    rspace        => "\t",
    note          => 'blah blah blah',
    timestamp     => $date,
    planner_name  => 'Barack Obama',
    planner_email => 'potus@whitehouse.gov',
), 'Create tag with more stuff';

my $ts2 = '2012-07-16T17:25:07Z';
is $tag->as_string,
    "  \@howdy $ts2 Barack Obama <potus\@whitehouse.gov>\t# blah blah blah",
    'It should as_string correctly';

$mock_plan->mock(index_of => 1);
$mock_plan->mock(change_at => $change);
is $tag->change, $change, 'Change should be correct';
is $tag->format_planner, 'Barack Obama <potus@whitehouse.gov>',
    'Planner name and email should format properly';

# Make sure it gets the change even if there is a tag in between.
my @prevs = ($tag, $change);
$mock_plan->mock(index_of => 8);
$mock_plan->mock(change_at => sub { shift @prevs });
is $tag->change, $change, 'Change should be for previous change';

is $tag->info, join("\n",
    'project sql',
    'uri https://github.com/theory/sqitch/',
    'tag @howdy',
    'change ' . $change->id,
    'planner Barack Obama <potus@whitehouse.gov>',
    'date 2012-07-16T17:25:07Z',
    '', 'blah blah blah',
), 'Tag info should include the change';

is $tag->id, do {
    my $content = $tag->info;
    Digest::SHA1->new->add(
        'tag ' . length($content) . "\0" . $content
    )->hexdigest;
},'Tag ID should be correct';

is $tag->old_info, join("\n",
    'project sql',
    'uri https://github.com/theory/sqitch/',
    'tag @howdy',
    'change ' . $change->old_id,
    'planner Barack Obama <potus@whitehouse.gov>',
    'date 2012-07-16T17:25:07Z'
), 'Old tag info should include the change';

is $tag->old_id, do {
    my $content = $tag->old_info;
    Digest::SHA1->new->add(
        'tag ' . length($content) . "\0" . $content
    )->hexdigest;
},'Old tag ID should be correct';

##############################################################################
# Test ID for a tag with a UTF-8 name.
ok $tag = $CLASS->new(
    name => '阱阪阬',
    plan => $plan,
    change  => $change,
), 'Create tag with UTF-8 name';

is $tag->info, join("\n",
    'project sql',
    'uri https://github.com/theory/sqitch/',
    'tag '     . '@阱阪阬',
    'change '  . $change->old_id,
    'planner ' . $tag->format_planner,
    'date '    . $tag->timestamp->as_string,
), 'The name should be decoded text in info';

is $tag->id, do {
    my $content = Encode::encode_utf8 $tag->info;
    Digest::SHA1->new->add(
        'tag ' . length($content) . "\0" . $content
    )->hexdigest;
},'Tag ID should be hahsed from encoded UTF-8';

is $tag->old_info, join("\n",
    'project sql',
    'uri https://github.com/theory/sqitch/',
    'tag '     . '@阱阪阬',
    'change '  . $change->old_id,
    'planner ' . $tag->format_planner,
    'date '    . $tag->timestamp->as_string,
), 'Old name should be decoded text in info';

is $tag->old_id, do {
    my $content = Encode::encode_utf8 $tag->old_info;
    Digest::SHA1->new->add(
        'tag ' . length($content) . "\0" . $content
    )->hexdigest;
},'Old tag ID should be hahsed from encoded UTF-8';