1package Scalar::Does; 2 3use 5.008; 4use strict; 5use warnings; 6use if $] < 5.010, 'UNIVERSAL::DOES'; 7 8METADATA: 9{ 10 $Scalar::Does::AUTHORITY = 'cpan:TOBYINK'; 11 $Scalar::Does::VERSION = '0.203'; 12} 13 14UTILITY_CLASS: 15{ 16 package Scalar::Does::RoleChecker; 17 $Scalar::Does::RoleChecker::AUTHORITY = 'cpan:TOBYINK'; 18 $Scalar::Does::RoleChecker::VERSION = '0.203'; 19 use base "Type::Tiny"; 20 sub new { 21 my $class = shift; 22 my ($name, $coderef); 23 for my $p (@_) 24 { 25 if (Scalar::Does::does($p, 'CODE')) { $coderef = $p } 26 if (Scalar::Does::does($p, 'HASH')) { $coderef = $p->{where} } 27 if (Scalar::Does::does($p, 'Regexp')){ $coderef = sub { $_[0] =~ $p } } 28 if (not ref $p) { $name = $p } 29 } 30 Carp::confess("Cannot make role without checker coderef or regexp") unless $coderef; 31 $class->SUPER::new(display_name => $name, constraint => $coderef); 32 } 33 sub code { shift->constraint }; 34} 35 36PRIVATE_STUFF: 37{ 38 sub _lu { 39 require lexical::underscore; 40 goto \&lexical::underscore; 41 } 42 43 use constant MISSING_ROLE_MESSAGE => ( 44 "Please supply a '-role' argument when exporting custom functions, died" 45 ); 46 47 use Carp 0 qw( confess ); 48 use Types::Standard 0.004 qw( -types ); 49} 50 51use namespace::clean 0.19; 52 53DEFINE_CONSTANTS: 54{ 55 our %_CONSTANTS = ( 56 BOOLEAN => q[bool], 57 STRING => q[""], 58 NUMBER => q[0+], 59 REGEXP => q[qr], 60 SMARTMATCH => q[~~], 61 map {; $_ => $_ } qw( 62 SCALAR ARRAY HASH CODE REF GLOB 63 LVALUE FORMAT IO VSTRING 64 ) 65 ); 66 require constant; 67 constant->import(\%_CONSTANTS); 68} 69 70EXPORTER: 71{ 72 use base "Exporter::Tiny"; 73 74 our %_CONSTANTS; 75 our @EXPORT = ( "does" ); 76 our @EXPORT_OK = ( 77 qw( does overloads blessed reftype looks_like_number make_role where custom ), 78 keys(%_CONSTANTS), 79 ); 80 our %EXPORT_TAGS = ( 81 constants => [ "does", keys(%_CONSTANTS) ], 82 only_constants => [ keys(%_CONSTANTS) ], 83 make => [ qw( make_role where ) ], 84 ); 85 86 sub _exporter_validate_opts 87 { 88 require B; 89 my $class = shift; 90 $_[0]{exporter} ||= sub { 91 my $into = $_[0]{into}; 92 my ($name, $sym) = @{ $_[1] }; 93 for (grep ref, $into->can($name)) 94 { 95 B::svref_2object($_)->STASH->NAME eq $into 96 and _croak("Refusing to overwrite local sub '$name' with export from $class"); 97 } 98 "namespace::clean"->import(-cleanee => $_[0]{into}, $name); 99 no strict qw(refs); 100 no warnings qw(redefine prototype); 101 *{"$into\::$name"} = $sym; 102 } 103 } 104} 105 106ROLES: 107{ 108 no warnings; 109 110 my $io = "Type::Tiny"->new( 111 display_name => "IO", 112 constraint => sub { require IO::Detect; IO::Detect::is_filehandle($_) }, 113 ); 114 115 our %_ROLES = ( 116 SCALAR => ( ScalarRef() | Ref->parameterize('SCALAR') | Overload->parameterize('${}') ), 117 ARRAY => ( ArrayRef() | Ref->parameterize('ARRAY') | Overload->parameterize('@{}') ), 118 HASH => ( HashRef() | Ref->parameterize('HASH') | Overload->parameterize('%{}') ), 119 CODE => ( CodeRef() | Ref->parameterize('CODE') | Overload->parameterize('&{}') ), 120 REF => ( Ref->parameterize('REF') ), 121 GLOB => ( GlobRef() | Ref->parameterize('GLOB') | Overload->parameterize('*{}') ), 122 LVALUE => ( Ref->parameterize('LVALUE') ), 123 FORMAT => ( Ref->parameterize('FORMAT') ), 124 IO => $io, 125 VSTRING => ( Ref->parameterize('VSTRING') ), 126 Regexp => ( RegexpRef() | Ref->parameterize('Regexp') | Overload->parameterize('qr') ), 127 bool => ( Value() | Overload->complementary_type | Overload->parameterize('bool') ), 128 q[""] => ( Value() | Overload->complementary_type | Overload->parameterize('""') ), 129 q[0+] => ( Value() | Overload->complementary_type | Overload->parameterize('0+') ), 130 q[<>] => ( Overload->parameterize('<>') | $io ), 131 q[~~] => ( Overload->parameterize('~~') | Object->complementary_type ), 132 q[${}] => 'SCALAR', 133 q[@{}] => 'ARRAY', 134 q[%{}] => 'HASH', 135 q[&{}] => 'CODE', 136 q[*{}] => 'GLOB', 137 q[qr] => 'Regexp', 138 ); 139 140 while (my ($k, $v) = each %_ROLES) { $_ROLES{$k} = $_ROLES{$v} unless ref $v } 141} 142 143PUBLIC_FUNCTIONS: 144{ 145 use Scalar::Util 1.24 qw( blessed reftype looks_like_number ); 146 147 sub overloads ($;$) 148 { 149 unshift @_, ${+_lu} if @_ == 1; 150 return unless blessed $_[0]; 151 goto \&overload::Method; 152 } 153 154 sub does ($;$) 155 { 156 unshift @_, ${+_lu} if @_ == 1; 157 my ($thing, $role) = @_; 158 159 no warnings; 160 our %_ROLES; 161 if (my $test = $_ROLES{$role}) 162 { 163 return !! $test->check($thing); 164 } 165 166 if (blessed $role and $role->can('check')) 167 { 168 return !! $role->check($thing); 169 } 170 171 if (blessed $thing && $thing->can('DOES')) 172 { 173 return !! 1 if $thing->DOES($role); 174 } 175 elsif (UNIVERSAL::can($thing, 'can') && $thing->can('DOES')) 176 { 177 my $class = $thing; 178 return '0E0' if $class->DOES($role); 179 } 180 181 return; 182 } 183 184 sub _generate_custom 185 { 186 my ($class, $name, $arg) = @_; 187 my $role = $arg->{ -role } or confess MISSING_ROLE_MESSAGE; 188 189 return sub (;$) { 190 push @_, $role; 191 goto \&does; 192 } 193 } 194 195 sub make_role 196 { 197 return "Scalar::Does::RoleChecker"->new(@_); 198 } 199 200 sub where (&) 201 { 202 return +{ where => $_[0] }; 203 } 204} 205 206"it does" 207__END__ 208 209=pod 210 211=encoding utf8 212 213=for stopwords vstring qr numifies 214 215=head1 NAME 216 217Scalar::Does - like ref() but useful 218 219=head1 SYNOPSIS 220 221 use Scalar::Does qw( -constants ); 222 223 my $object = bless {}, 'Some::Class'; 224 225 does($object, 'Some::Class'); # true 226 does($object, '%{}'); # true 227 does($object, HASH); # true 228 does($object, ARRAY); # false 229 230=head1 DESCRIPTION 231 232It has long been noted that Perl would benefit from a C<< does() >> built-in. 233A check that C<< ref($thing) eq 'ARRAY' >> doesn't allow you to accept an 234object that uses overloading to provide an array-like interface. 235 236=head2 Functions 237 238=over 239 240=item C<< does($scalar, $role) >> 241 242Checks if a scalar is capable of performing the given role. The following 243(case-sensitive) roles are predefined: 244 245=over 246 247=item * B<SCALAR> or B<< ${} >> 248 249Checks if the scalar can be used as a scalar reference. 250 251Note: this role does not check whether a scalar is a scalar (which is 252obviously true) but whether it is a reference to another scalar. 253 254=item * B<ARRAY> or B<< @{} >> 255 256Checks if the scalar can be used as an array reference. 257 258=item * B<HASH> or B<< %{} >> 259 260Checks if the scalar can be used as a hash reference. 261 262=item * B<CODE> or B<< &{} >> 263 264Checks if the scalar can be used as a code reference. 265 266=item * B<GLOB> or B<< *{} >> 267 268Checks if the scalar can be used as a glob reference. 269 270=item * B<REF> 271 272Checks if the scalar can be used as a ref reference (i.e. a reference to 273another reference). 274 275=item * B<LVALUE> 276 277Checks if the scalar is a reference to a special lvalue (e.g. the result 278of C<< substr >> or C<< splice >>). 279 280=item * B<IO> or B<< <> >> 281 282Uses L<IO::Detect> to check if the scalar is a filehandle or file-handle-like 283object. 284 285(The C<< <> >> check is slightly looser, allowing objects which overload 286C<< <> >>, though overloading C<< <> >> well can be a little tricky.) 287 288=item * B<VSTRING> 289 290Checks if the scalar is a vstring reference. 291 292=item * B<FORMAT> 293 294Checks if the scalar is a format reference. 295 296=item * B<Regexp> or B<< qr >> 297 298Checks if the scalar can be used as a quoted regular expression. 299 300=item * B<bool> 301 302Checks if the scalar can be used as a boolean. (It's pretty rare for this 303to not be true.) 304 305=item * B<< "" >> 306 307Checks if the scalar can be used as a string. (It's pretty rare for this 308to not be true.) 309 310=item * B<< 0+ >> 311 312Checks if the scalar can be used as a number. (It's pretty rare for this 313to not be true.) 314 315Note that this is far looser than C<looks_like_number> from L<Scalar::Util>. 316For example, an unblessed arrayref can be used as a number (it numifies to 317its reference address); the string "Hello World" can be used as a number (it 318numifies to 0). 319 320=item * B<< ~~ >> 321 322Checks if the scalar can be used on the right hand side of a smart match. 323 324=back 325 326If the given I<role> is blessed, and provides a C<check> method, then 327C<< does >> delegates to that. 328 329Otherwise, if the scalar being tested is blessed, then 330C<< $scalar->DOES($role) >> is called, and C<does> returns true if 331the method call returned true. 332 333If the scalar being tested looks like a Perl class name, then 334C<< $scalar->DOES($role) >> is also called, and the string "0E0" is 335returned for success, which evaluates to 0 in a numeric context but 336true in a boolean context. 337 338=item C<< does($role) >> 339 340Called with a single argument, tests C<< $_ >>. Yes, this works with lexical 341C<< $_ >>. 342 343 given ($object) { 344 when(does ARRAY) { ... } 345 when(does HASH) { ... } 346 } 347 348Note: in Scalar::Does 0.007 and below the single-argument form of C<does> 349returned a curried coderef. This was changed in Scalar::Does 0.008. 350 351=item C<< overloads($scalar, $role) >> 352 353A function C<overloads> (which just checks overloading) is also available. 354 355=item C<< overloads($role) >> 356 357Called with a single argument, tests C<< $_ >>. Yes, this works with lexical 358C<< $_ >>. 359 360Note: in Scalar::Does 0.007 and below the single-argument form of C<overloads> 361returned a curried coderef. This was changed in Scalar::Does 0.008. 362 363=item C<< blessed($scalar) >>, C<< reftype($scalar) >>, C<< looks_like_number($scalar) >> 364 365For convenience, this module can also re-export these functions from 366L<Scalar::Util>. C<looks_like_number> is generally more useful than 367C<< does($scalar, q[0+]) >>. 368 369=item C<< make_role $name, where { BLOCK } >> 370 371Returns an anonymous role object which can be used as a parameter to 372C<does>. The block is arbitrary code which should check whether $_[0] 373does the role. 374 375=item C<< where { BLOCK } >> 376 377Syntactic sugar for C<make_role>. Compatible with the C<where> function 378from L<Moose::Util::TypeConstraints>, so don't worry about conflicts. 379 380=back 381 382=head2 Constants 383 384The following constants may be exported for convenience: 385 386=over 387 388=item C<SCALAR> 389 390=item C<ARRAY> 391 392=item C<HASH> 393 394=item C<CODE> 395 396=item C<GLOB> 397 398=item C<REF> 399 400=item C<LVALUE> 401 402=item C<IO> 403 404=item C<VSTRING> 405 406=item C<FORMAT> 407 408=item C<REGEXP> 409 410=item C<BOOLEAN> 411 412=item C<STRING> 413 414=item C<NUMBER> 415 416=item C<SMARTMATCH> 417 418=back 419 420=head2 Export 421 422By default, only C<does> is exported. This module uses L<Exporter::Tiny>, so 423functions can be renamed: 424 425 use Scalar::Does does => { -as => 'performs_role' }; 426 427Scalar::Does also plays some tricks with L<namespace::clean> to ensure that 428any functions it exports to your namespace are cleaned up when you're finished 429with them. This ensures that if you're writing object-oriented code C<does> 430and C<overloads> will not be left hanging around as methods of your classes. 431L<Moose::Object> provides a C<does> method, and you should be able to use 432Scalar::Does without interfering with that. 433 434You can import the constants (plus C<does>) using: 435 436 use Scalar::Does -constants; 437 438The C<make_role> and C<where> functions can be exported like this: 439 440 use Scalar::Does -make; 441 442Or list specific functions/constants that you wish to import: 443 444 use Scalar::Does qw( does ARRAY HASH STRING NUMBER ); 445 446=head2 Custom Role Checks 447 448 use Scalar::Does 449 custom => { -as => 'does_array', -role => 'ARRAY' }, 450 custom => { -as => 'does_hash', -role => 'HASH' }; 451 452 does_array($thing); 453 does_hash($thing); 454 455=head1 BUGS 456 457Please report any bugs to 458L<http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Does>. 459 460=head1 SEE ALSO 461 462L<Scalar::Util>. 463 464L<http://perldoc.perl.org/5.10.0/perltodo.html#A-does()-built-in>. 465 466=head2 Relationship to Moose roles 467 468Scalar::Does is not dependent on Moose, and its role-checking is not specific 469to Moose's idea of roles, but it does work well with Moose roles. 470 471Moose::Object overrides C<DOES>, so Moose objects and Moose roles should 472"just work" with Scalar::Does. 473 474 { 475 package Transport; 476 use Moose::Role; 477 } 478 479 { 480 package Train; 481 use Moose; 482 with qw(Transport); 483 } 484 485 my $thomas = Train->new; 486 does($thomas, 'Train'); # true 487 does($thomas, 'Transport'); # true 488 does($thomas, Transport->meta); # not yet supported! 489 490L<Mouse::Object> should be compatible enough to work as well. 491 492See also: 493L<Moose::Role>, 494L<Moose::Object>, 495L<UNIVERSAL>. 496 497=head2 Relationship to Moose type constraints 498 499L<Moose::Meta::TypeConstraint> objects, plus the constants exported by 500L<MooseX::Types> libraries all provide a C<check> method, so again, should 501"just work" with Scalar::Does. Type constraint strings are not supported 502however. 503 504 use Moose::Util::TypeConstraints qw(find_type_constraint); 505 use MooseX::Types qw(Int); 506 use Scalar::Does qw(does); 507 508 my $int = find_type_constraint("Int"); 509 510 does( "123", $int ); # true 511 does( "123", Int ); # true 512 does( "123", "Int" ); # false 513 514L<Mouse::Meta::TypeConstraint>s and L<MouseX::Types> should be compatible 515enough to work as well. 516 517See also: 518L<Moose::Meta::TypeConstraint>, 519L<Moose::Util::TypeConstraints>, 520L<MooseX::Types>, 521L<Scalar::Does::MooseTypes>. 522 523=head2 Relationship to Type::Tiny type constraints 524 525Types built with L<Type::Tiny> and L<Type::Library> can be used exactly as 526Moose type constraint objects above. 527 528 use Types::Standard qw(Int); 529 use Scalar::Does qw(does); 530 531 does(123, Int); # true 532 533In fact, L<Type::Tiny> and related libraries are used extensively in the 534internals of Scalar::Does 0.200+. 535 536See also: 537L<Type::Tiny>, 538L<Types::Standard>. 539 540=head2 Relationship to Role::Tiny and Moo roles 541 542Roles using Role::Tiny 1.002000 and above provide a C<DOES> method, so 543should work with Scalar::Does just like Moose roles. Prior to that release, 544Role::Tiny did not provide C<DOES>. 545 546Moo's role system is based on Role::Tiny. 547 548See also: 549L<Role::Tiny>, 550L<Moo::Role>. 551 552=head1 AUTHOR 553 554Toby Inkster E<lt>tobyink@cpan.orgE<gt>. 555 556=head1 COPYRIGHT AND LICENCE 557 558This software is copyright (c) 2012-2014, 2017 by Toby Inkster. 559 560This is free software; you can redistribute it and/or modify it under 561the same terms as the Perl 5 programming language system itself. 562 563=head1 DISCLAIMER OF WARRANTIES 564 565THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED 566WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 567MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 568 569