fork download
copy 
  1. #!/usr/bin/perl
  2.  
  3. # Idiom #267 Pass string to argument that can be of any type
  4.  
  5. use v5.28;
  6.  
  7. use Scalar::Util qw(looks_like_number);
  8.  
  9. # simplistic implementation but likely covers 98% of what you'd need
  10. sub foo {
  11.     my ($s, $x) = @_;
  12.     return 'is undefined'   if not defined $x;
  13.     return 'is a reference' if ref $x ne '';
  14.     return 'is a number'    if looks_like_number $s;
  15.     return 'is a string';
  16. }
  17.  
  18. # comprehensive implementation that tests for all perl datatypes
  19. sub whatis {
  20.     my ($s, $x) = @_;
  21.     my $r = ref $x;
  22.     my @list;
  23.     push @list, ' is undefined' if not defined $x;
  24.     push @list, ' is an ARRAY ref'  if $r eq 'ARRAY';
  25.     push @list, ' is a HASH ref'    if $r eq 'HASH';
  26.     push @list, ' is a CODE ref'    if $r eq 'CODE';
  27.     push @list, ' is a FORMAT ref'  if $r eq 'FORMAT';
  28.     push @list, ' is a IO ref'      if $r eq 'IO';
  29.  
  30.     my $m = ' is a SCALAR that';
  31.  
  32.     push @list, ' looks like a number' 
  33.                             if looks_like_number($x);
  34.  
  35.     push @list, ' is a SCALAR ref' if $r eq 'SCALAR';
  36.     push @list, ' is a REF'        if $r eq 'REF';
  37.     push @list, ' is a VSTRING'    if $r eq 'VSTRING';
  38.     push @list, ' is a GLOB ref'   if $r eq 'GLOB';
  39.     push @list, ' is a LVALUE'     if $r eq 'LVALUE';
  40.     push @list, ' is a REGEXP'     if $r eq 'REGEXP';
  41.     push @list, ' is a Regexp'     if $r eq 'Regexp';
  42.  
  43.     push @list, ' is a ' . $r      if $r ne '' and not @list;
  44.  
  45.     push @list, ' is likely a string (ref=' . $r . ')'
  46.         unless @list;
  47.  
  48.     return sprintf qq(%-25s   %s), $s, join ', "', @list;
  49. }
  50.  
  51. format fmt =
  52.    Test: @<<<<<<<< @||||| @>>>>>
  53. .
  54.  
  55. my $str;
  56. open my $fh, '<', \$str;
  57.  
  58. use IO::File;
  59. my $io = IO::File->new();
  60.  
  61. my $lv = \ substr $str, 0, 2;
  62. my $vs = v1.23.456;
  63. my $vs_ref = \$vs;
  64. my $my_obj = {};
  65. bless $my_obj, 'MyClass';
  66.  
  67. my @tests = (
  68.     [ 'undef'                , undef         ],
  69.     [ 'Hello World'          , 'Hello World' ],
  70.     [ "'abc'"                , 'string'      ],
  71.     [ '42'                   , 42            ],
  72.     [ '[]'                   , []            ],
  73.     [ "\\'ref'"              , \'ref'        ],
  74.     [ "\\\\'refref'"         , \\'refref'    ],
  75.     [ 'sub {}'               , sub {},       ],
  76.     [ '*fmt{FORMAT}'         , *fmt{FORMAT}  ],
  77.     [ '/^http:/'             , qr/^http:/    ],
  78.     [ '$fh'                  , $fh           ],
  79.     [ '\*STDIN'              , \*STDIN       ],
  80.     [ '\substr($str,0,1))'   , $lv           ],
  81.     [ 'v1.23.456'            , $vs_ref       ],
  82.     [ '\$io'                 , \$io          ],
  83.     [ '$io_ref'              , $io           ],
  84.     [ '$my_obj'              , $my_obj       ],
  85. );
  86.  
  87. say "### simplistic tests ###\n";
  88.  
  89. foreach my $t (@tests) {
  90.     my ($s, $x) = @$t;
  91.     printf "%-25s    %s\n", $s, foo($s, $x);
  92. }
  93.  
  94. say "\n### comprehensive tests ###\n";
  95.  
  96. foreach my $t (@tests) {
  97.     my ($s, $x) = @$t;
  98.     say whatis($s, $x);
  99. }
  100.  
  101.  
  102. close $fh;
  103. $io->close;
  104.  
Success #stdin #stdout 0.02s 6752KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
### simplistic tests ###

undef                        is undefined
Hello World                  is a string
'abc'                        is a string
42                           is a number
[]                           is a reference
\'ref'                       is a reference
\\'refref'                   is a reference
sub {}                       is a reference
*fmt{FORMAT}                 is a reference
/^http:/                     is a reference
$fh                          is a reference
\*STDIN                      is a reference
\substr($str,0,1))           is a reference
v1.23.456                    is a reference
\$io                         is a reference
$io_ref                      is a reference
$my_obj                      is a reference

### comprehensive tests ###

undef                        is undefined
Hello World                  is likely a string (ref=)
'abc'                        is likely a string (ref=)
42                           looks like a number
[]                           is an ARRAY ref
\'ref'                       is a SCALAR ref
\\'refref'                   is a REF
sub {}                       is a CODE ref
*fmt{FORMAT}                 is a FORMAT ref
/^http:/                     is a Regexp
$fh                          is a GLOB ref
\*STDIN                      is a GLOB ref
\substr($str,0,1))           is a LVALUE
v1.23.456                    is a VSTRING
\$io                         is a REF
$io_ref                      is a IO::File
$my_obj                      is a MyClass
https://ideone.com/TuMyjo
Idiom #267 Pass string to argument that can be of any type
language:
Perl (perl 5.28.1)
created:
1 year ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!