The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Mojo::Base -strict;
use Test::More;

use File::Temp 'tempdir';
use File::Spec::Functions 'catfile';
use Mojar::Util qw(check_exists dumper hash_or_hashref spurt snakecase
    unsnakecase transcribe);
use Mojo::Util 'slurp';

subtest q{snakecase} => sub {
  is +(snakecase 'FooBar'), 'foo_bar', 'FooBar';
  is +(snakecase 'fooBar'), 'foo_bar', 'fooBar';
  is +(snakecase 'BBC'), 'b_b_c', 'BBC';
  is +(snakecase 'TEAM_GB'), 't_e_a_m_g_b', 'TEAM_GB';
};

subtest q{unsnakecase} => sub {
  is +(unsnakecase 'FooBar'), 'Foobar', 'FooBar';
  is +(unsnakecase 'foobar'), 'Foobar', 'foobar';
  is +(unsnakecase 'foo_bar'), 'FooBar', 'foo_bar';
  is +(unsnakecase '__foo_bar__'), '__FooBar__', 'foo_bar';
  is +(unsnakecase 'foo.bar', '.'), 'FooBar', 'foo.bar';
  is +(unsnakecase '-foo_bar'), '-fooBar', '-foo_bar';
  is +(unsnakecase 'foo-bar', '-'), 'FooBar', q{foo-bar & '-'};
  is +(unsnakecase '--foo-bar', '-'), '--FooBar', q{--foo-bar & '-'};
  is +(unsnakecase 'foo', undef, 1), 'foo', 'foo & camelcase';
  is +(unsnakecase 'foo_bar_baz', undef, 1), 'fooBarBaz',
      'foo_bar_baz & camelcase';
  is +(unsnakecase 't_e_a_m__g_b'), 'TEAM_GB', 'TEAM_GB';
};

subtest q{Round trip} => sub {
  d_t('foo_bar');
  d_t('bbc');
  d_t('en-gb');
  t_d('BBC');
  t_d('Bbc');
#  t_d('TEAM_USA');  # Does not round trip
};

subtest q{transcribe} => sub {
  is +(transcribe 'abc', '_' => '-', '::' => '/'), 'abc', q{nothing to do};
  is +(transcribe '', '_' => '-'), '', q{empty string};
  ok !(defined transcribe undef, '_' => '-'), q{undef};

  is +(transcribe 'admin_profile-perm_edit', '_' => '-', '-' => '_'),
    'admin-profile_perm-edit', q{swap separators};

  is +(transcribe 'a__b__c', '_' => '-'), 'a--b--c', q{doubled separator};
  is +(transcribe 'a__$__c', '$' => '£', '_' => '-'), 'a--£--c',
      q{doubled sep incl sep};
  is +(transcribe 'a__$__c', '_' => '-', '$' => '£'), 'a--£--c',
      q{doubled sep incl sep with diff order};
  is +(transcribe 'a.c..', '.' => '*'), 'a*c**', q{sep at end};
  is +(transcribe 'a::b_c_d::e::f::g_h', '_' => '-', '::' => '/'), 'a/b-c-d/e/f/g-h', q{'_' => '-'};

  is +(transcribe '__abc_def__', '_' => '-', sub { unsnakecase $_[0] }),
      '--Abc-Def--', q{with translator (unsnakecase)};
  is +(transcribe '__AbcDef__', '_' => '-', sub { snakecase $_[0], '-' }),
      '--abc-def--', q{with translator (snakecase)};
  is +(transcribe 'Pool::DbConnector::Mysql',
        '::' => '_',
        sub { snakecase $_[0], '-' }),
      'pool_db-connector_mysql', q{class -> file};
  is +(transcribe 'Model::DbConnector::Mysql',
        '::' => '/',
        sub { snakecase $_[0] }),
      'model/db_connector/mysql', q{class -> path};
  # And having fun, but not realistic...
  is +(transcribe 'admin/user/profile_perm?safe=1',
        '/' => '::', '?' => '::_', '=1' => '',
        sub { unsnakecase $_[0] }),
      'Admin::User::ProfilePerm::_Safe', q{url_path -> class};
};

subtest q{spurt} => sub {
  my $dir = tempdir CLEANUP => 1;
  my $path = catfile $dir, 'test.txt';
  ok !! spurt $path, "Some\ntext\n";
  is slurp($path), "Some\ntext\n", 'same text back';
  ok !! spurt $path, "More\n", "lines\n";
  is slurp($path), "More\nlines\n", 'same text back';
};

subtest q{dumper} => sub {
  is dumper(undef), "undef", 'undef';
  is dumper('Abc'), "'Abc'", 'string';
  is dumper(1.23), "'1.23'", 'numeric';
  is dumper({A => 1}), "{\n  A => 1\n}", 'simple hashref';
  my $abc = [qw(A B C)];
  is dumper($abc), "[\n  'A',\n  'B',\n  'C'\n]", 'simple arrayref';
  my $abc_r = \$abc;
  is dumper($abc_r), "\\[\n    'A',\n    'B',\n    'C'\n  ]", 'arrayrefref';
  is dumper(\$abc_r), "\\\\[\n      'A',\n      'B',\n      'C'\n    ]",
      'arrayrefrefref';
  is dumper('Abc', $abc), "'Abc'\n[\n  'A',\n  'B',\n  'C'\n]", 'list';
};

subtest q{hash_or_hashref} => sub {
  is dumper(hash_or_hashref()), "{}", 'no args';
  is dumper(hash_or_hashref {A => 1}), "{\n  A => 1\n}", 'hashref';
  is dumper(hash_or_hashref B => 2), "{\n  B => 2\n}", 'hash';
  my $o = bless {} => 'UNIVERSAL';
  ok $o->isa('UNIVERSAL'), 'test object constructed ok';
  is_deeply hash_or_hashref($o), $o, 'object';
};

subtest q{check_exists} => sub {
  my $r = [qw(abc xyz)];
  my $o = { abc => 'ABC', xyz => 'XYZ' };
  is join('|', check_exists($r, $o)), 'ABC|XYZ', 'arrayref & hashref';
  is join('|', check_exists('abc', $o)), 'ABC', 'scalar & hashref';
  my %o = ( abc => 'ABC', xyz => 'XYZ' );
  is join('|', check_exists($r, %o)), 'ABC|XYZ', 'arrayref & hash';
  is join('|', check_exists('xyz', %o)), 'XYZ', 'scalar & hash';

  eval { check_exists('xxx', %o) };
  like $@, qr/^Missing required param \Q(xxx)\E/, 'not found (scalar)';
  push @$r, qw(hmmm errr);
  eval { check_exists($r, $o) };
  like $@, qr/^Missing required param \Q(hmmm)\E/, 'not found (arrayref)';
};

done_testing();

sub t_d {
  my $string = shift;
  is +(unsnakecase snakecase $string), $string, 't d '. $string;
}

sub d_t {
  my $string = shift;
  is +(snakecase unsnakecase $string), $string, 'd t '. $string;
}