#!/usr/bin/perl

# Idiom #267 Pass string to argument that can be of any type

use v5.28;

use Scalar::Util qw(looks_like_number);

# simplistic implementation but likely covers 98% of what you'd need
sub foo {
    my ($s, $x) = @_;
    return 'is undefined'   if not defined $x;
    return 'is a reference' if ref $x ne '';
    return 'is a number'    if looks_like_number $s;
    return 'is a string';
}

# comprehensive implementation that tests for all perl datatypes
sub whatis {
    my ($s, $x) = @_;
    my $r = ref $x;
    my @list;
    push @list, ' is undefined' if not defined $x;
    push @list, ' is an ARRAY ref'  if $r eq 'ARRAY';
    push @list, ' is a HASH ref'    if $r eq 'HASH';
    push @list, ' is a CODE ref'    if $r eq 'CODE';
    push @list, ' is a FORMAT ref'  if $r eq 'FORMAT';
    push @list, ' is a IO ref'      if $r eq 'IO';
    
    my $m = ' is a SCALAR that';
    
    push @list, ' looks like a number' 
                            if looks_like_number($x);
  
    push @list, ' is a SCALAR ref' if $r eq 'SCALAR';
    push @list, ' is a REF'        if $r eq 'REF';
    push @list, ' is a VSTRING'    if $r eq 'VSTRING';
    push @list, ' is a GLOB ref'   if $r eq 'GLOB';
    push @list, ' is a LVALUE'     if $r eq 'LVALUE';
    push @list, ' is a REGEXP'     if $r eq 'REGEXP';
    push @list, ' is a Regexp'     if $r eq 'Regexp';
    
    push @list, ' is a ' . $r      if $r ne '' and not @list;

    push @list, ' is likely a string (ref=' . $r . ')'
        unless @list;
   
    return sprintf qq(%-25s   %s), $s, join ', "', @list;
}

format fmt =
   Test: @<<<<<<<< @||||| @>>>>>
.

my $str;
open my $fh, '<', \$str;

use IO::File;
my $io = IO::File->new();

my $lv = \ substr $str, 0, 2;
my $vs = v1.23.456;
my $vs_ref = \$vs;
my $my_obj = {};
bless $my_obj, 'MyClass';

my @tests = (
    [ 'undef'                , undef         ],
    [ 'Hello World'          , 'Hello World' ],
    [ "'abc'"                , 'string'      ],
    [ '42'                   , 42            ],
    [ '[]'                   , []            ],
    [ "\\'ref'"              , \'ref'        ],
    [ "\\\\'refref'"         , \\'refref'    ],
    [ 'sub {}'               , sub {},       ],
    [ '*fmt{FORMAT}'         , *fmt{FORMAT}  ],
    [ '/^http:/'             , qr/^http:/    ],
    [ '$fh'                  , $fh           ],
    [ '\*STDIN'              , \*STDIN       ],
    [ '\substr($str,0,1))'   , $lv           ],
    [ 'v1.23.456'            , $vs_ref       ],
    [ '\$io'                 , \$io          ],
    [ '$io_ref'              , $io           ],
    [ '$my_obj'              , $my_obj       ],
);

say "### simplistic tests ###\n";

foreach my $t (@tests) {
    my ($s, $x) = @$t;
    printf "%-25s    %s\n", $s, foo($s, $x);
}

say "\n### comprehensive tests ###\n";

foreach my $t (@tests) {
    my ($s, $x) = @$t;
    say whatis($s, $x);
}


close $fh;
$io->close;