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 lib qw(./lib);

use Test::More tests => 41;
use Data::Dumper;

# Check we can load module
BEGIN { use_ok('Text::vCard::Node'); }

local $SIG{__WARN__} = sub { die $_[0] };

#####
# Set up some test data
#####

# ok data
my %data = (
    'params' => [ { 'type' => 'HOME,PREF', }, ],
    'value' =>
        ';;First work address - street;Work city;London;Work PostCode;CountryName',
);

# Address fields
my $fields = [
    'po_box', 'extended',  'street', 'city',
    'region', 'post_code', 'country'
];

#####
# Test new()
#####

my $foo = Text::vCard::Node::new( 'foo::bar', { fields => ['value'] } );

is( ref($foo), 'foo::bar', 'Can use as a base class' );

my $hash
    = Text::vCard::Node::new( { foo => 'bar' }, { 'fields' => ['value'] } );
is( ref($hash), 'HASH', 'new() retruns HASH when supplied hash' );

eval { Text::vCard::Node::new( undef, { 'fields' => ['value'] } ); };
like( $@, qr/Use of uninitialized value/, 'Errors if no class supplied' );
$@ = 'foo';

eval { Text::vCard::Node->new( {} ); };
like( $@, qr/No fields defined/, 'new() carps when no fields supplied' );

eval { Text::vCard::Node->new( { 'fields' => { 'duff' => 'hash' } } ); };
like(
    $@,
    qr/fields is not an array ref/,
    'new() carps when fields is not an array ref'
);

my %too_many_value_data
    = ( 'value' =>
        'asd;Street;Work city;London;Work PostCode;CountryName;more;values',
    );
eval {
    my $duff = Text::vCard::Node->new(
        {   fields => $fields,
            data   => \%too_many_value_data,
        }
    );
};
like(
    $@,
    qr/Data value had 8 elements expecting 7 or less/,
    'new() carp on wrong number of elements in value comp to fields'
);

my %a_few_data_points = ( 'value' => 'x;s;Street;City', );

# Working nodes
my $nod_few_fields = Text::vCard::Node->new(
    {   fields => $fields,
        data   => \%a_few_data_points,
    }
);
is( $nod_few_fields->street(),
    'Street', 'new() - less data than fields, field set ok' );
is( $nod_few_fields->post_code(),
    undef, 'new() - less data, empty field returns undef' );
$nod_few_fields->post_code('postcode');
is( $nod_few_fields->post_code(),
    'postcode', 'new() - less data, set empty field' );

# Create without a node_type - should be fine
my $no = Text::vCard::Node->new(
    {   fields => $fields,
        data   => \%data,
    }
);

# Create without a data - should be fine
my $no_data = Text::vCard::Node->new( { fields => $fields, } );
is( $no_data->street(), undef,
    'Created node with no data and methods created' );

# Create 'working' node
my $node = Text::vCard::Node->new(
    {   node_type => 'address',    # Auto upper cased
        fields    => $fields,
        data      => \%data,
        group     => 'item1',
    }
);

is( $no->street(), $node->street(),
    'new() without node_type still works ok' );
is( $node->group(),       'item1', 'got group as it was set' );
is( $node->group('FooF'), 'foof',  'set node worked' );
###
# ORG
###
my %orgdata = ( 'value' => 'name;unit;extra', );
my $org = Text::vCard::Node->new(
    {   node_type => 'ORG',
        fields    => [ 'name', 'unit' ],
        data      => \%orgdata,
    }
);
is( scalar( @{ $org->unit() } ), 2, 'org - Got two elements back from unit' );
my @new_org = qw(a b c);
is( scalar( @{ $org->unit( \@new_org ) } ),
    3, 'org - Got the elements back from setting unit' );

is( scalar( @{ $org->unit('foo') } ),
    3, 'org - Got the elements back from trying to set unit with string' );

my %single_org = ( 'value' => 'just_name', );
my $org_name = Text::vCard::Node->new(
    {   node_type => 'ORG',
        fields    => [ 'name', 'unit' ],
        data      => \%single_org,
    }
);
is( $org_name->unit(), undef, 'org - copes with unit being empty' );

#####
# types()
#####
my $types = $node->types();
my @types = $node->types();
ok( scalar(@types), 'types() returns stuff' );
ok( eq_array( $types, \@types ), 'types() ok in array or scalar context' );
is( $no_data->types(), undef, 'types() get undef when there are none' );

#####
# is_type()
#####
ok( $node->is_type('home'),  'is_type() home type matches' );
ok( !$node->is_type('work'), 'is_type() not work address type' );
is( $no_data->is_type('work'), undef, 'is_type() undef when no params' );

#####
# is_pref()
#####
ok( $node->is_pref(), 'is_pref() this is a prefered address' );
$node->remove_types('pref');
is( $node->is_pref(),    undef, 'is_pref() get undef when not pref' );
is( $no_data->is_pref(), undef, 'is_pref() get undef if no params' );

#####
# remove_types()
#####
is( $no_data->remove_types('wibble'),
    undef, 'remove_types() when no params - no error' );
is( $node->remove_types('wibble'),
    undef, 'remove_types() undef when scalar, node has params and no match' );
is( $node->remove_types( ['home'] ),
    1, 'remove_types() get a true value in array context when sucess' );

#####
# add_types()
#####
# Test the types
$node->add_types('WoRk');
ok( $node->is_type('wOrk'),
    'is_type() Added work type and check non-cases sensative' );
$node->remove_types( [ 'Work', 'Home' ] );
ok( !$node->is_type('Work'),
    'is_type() Removed work type and check non-cases sensative' );
ok( !$node->is_type('home'), 'is_type() Removed several types' );
$node->add_types( [ 'work', 'home' ] );
ok( $node->is_type('work') && $node->is_type('home'),
    'is_type() Added two types ok' );
$no_data->add_types('work');
ok( $no_data->is_type('work'),
    'is_type() Added type to node with no params' );

#####
# AUTOLOAD
#####

is( $node->po_box(), '', 'AUTOLOAD - Po box empty as expected' );
is( $node->street(),
    'First work address - street',
    'AUTOLOAD - Street address matches'
);
is( $node->country('Moose vill'), 'Moose vill', 'AUTOLOAD - set ok' );

eval { $node->duff_method(); };
like(
    $@,
    qr/duff_method method which is not valid for this node/,
    'AUTOLOAD - carp when method not valid'
);

####
# export_data()
####
my $export
    = ';;First work address - street;Work city;London;Work PostCode;Moose vill';
is( $node->export_data(), $export,
    'export_data() - Node returns expected data' );

delete $node->{'po_box'};
is( $node->export_data(), $export,
    'export_data() - Node returns expected data, with undef entry' );

# Test non-existant methods