r117 - in packages: . libparams-classify-perl libparams-classify-perl/branches libparams-classify-perl/branches/upstream libparams-classify-perl/branches/upstream/current libparams-classify-perl/branches/upstream/current/lib libparams-classify-perl/branches/upstream/current/lib/Params libparams-classify-perl/branches/upstream/current/t
Allard Hoeve
hoeve-guest@haydn.debian.org
Thu, 10 Jun 2004 08:07:06 -0600
Author: hoeve-guest
Date: 2004-06-10 08:07:01 -0600 (Thu, 10 Jun 2004)
New Revision: 117
Added:
packages/libparams-classify-perl/
packages/libparams-classify-perl/branches/
packages/libparams-classify-perl/branches/upstream/
packages/libparams-classify-perl/branches/upstream/current/
packages/libparams-classify-perl/branches/upstream/current/.cvsignore
packages/libparams-classify-perl/branches/upstream/current/MANIFEST
packages/libparams-classify-perl/branches/upstream/current/Makefile.PL
packages/libparams-classify-perl/branches/upstream/current/README
packages/libparams-classify-perl/branches/upstream/current/lib/
packages/libparams-classify-perl/branches/upstream/current/lib/Params/
packages/libparams-classify-perl/branches/upstream/current/lib/Params/Classify.pm
packages/libparams-classify-perl/branches/upstream/current/t/
packages/libparams-classify-perl/branches/upstream/current/t/blessed.t
packages/libparams-classify-perl/branches/upstream/current/t/classify.t
packages/libparams-classify-perl/branches/upstream/current/t/ref.t
packages/libparams-classify-perl/tags/
Log:
[svn-inject] Installing original source of libparams-classify-perl
Added: packages/libparams-classify-perl/branches/upstream/current/.cvsignore
===================================================================
--- packages/libparams-classify-perl/branches/upstream/current/.cvsignore 2004-06-10 14:06:08 UTC (rev 116)
+++ packages/libparams-classify-perl/branches/upstream/current/.cvsignore 2004-06-10 14:07:01 UTC (rev 117)
@@ -0,0 +1,4 @@
+Makefile Makefile.old
+blib pm_to_blib
+META.yml
+IPC-Signal-Force-*
Added: packages/libparams-classify-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libparams-classify-perl/branches/upstream/current/MANIFEST 2004-06-10 14:06:08 UTC (rev 116)
+++ packages/libparams-classify-perl/branches/upstream/current/MANIFEST 2004-06-10 14:07:01 UTC (rev 117)
@@ -0,0 +1,9 @@
+.cvsignore
+MANIFEST
+META.yml
+Makefile.PL
+README
+lib/Params/Classify.pm
+t/blessed.t
+t/classify.t
+t/ref.t
Added: packages/libparams-classify-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libparams-classify-perl/branches/upstream/current/Makefile.PL 2004-06-10 14:06:08 UTC (rev 116)
+++ packages/libparams-classify-perl/branches/upstream/current/Makefile.PL 2004-06-10 14:07:01 UTC (rev 117)
@@ -0,0 +1,6 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "Params::Classify",
+ VERSION_FROM => "lib/Params/Classify.pm",
+);
Added: packages/libparams-classify-perl/branches/upstream/current/README
===================================================================
--- packages/libparams-classify-perl/branches/upstream/current/README 2004-06-10 14:06:08 UTC (rev 116)
+++ packages/libparams-classify-perl/branches/upstream/current/README 2004-06-10 14:07:01 UTC (rev 117)
@@ -0,0 +1,34 @@
+NAME
+
+Params::Classify - argument type classification
+
+DESCRIPTION
+
+This module provides various type-testing functions. These are intended
+for functions that, unlike most Perl code, care what type of data they
+are operating on. For example, some functions wish to behave differently
+depending on the type of their arguments (like overloaded functions
+in C++).
+
+These functions only provide type classification; they do not enforce
+type restrictions. Type enforcement may, of course, be built using
+these classification functions, but the reader's attention is drawn
+to Params::Validate.
+
+INSTALLATION
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+AUTHOR
+
+Andrew Main (Zefram) <zefram@fysh.org>
+
+COPYRIGHT
+
+Copyright (C) 2004 Andrew Main (Zefram) <zefram@fysh.org>
+
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
Added: packages/libparams-classify-perl/branches/upstream/current/lib/Params/Classify.pm
===================================================================
--- packages/libparams-classify-perl/branches/upstream/current/lib/Params/Classify.pm 2004-06-10 14:06:08 UTC (rev 116)
+++ packages/libparams-classify-perl/branches/upstream/current/lib/Params/Classify.pm 2004-06-10 14:07:01 UTC (rev 117)
@@ -0,0 +1,407 @@
+=head1 NAME
+
+Params::Classify - argument type classification
+
+=head1 SYNOPSIS
+
+ use Params::Classify qw(scalar_class
+ is_undef
+ is_string is_number
+ is_glob
+ is_ref ref_type
+ is_blessed blessed_class
+ is_strictly_blessed is_able);
+
+ $c = scalar_class($foo);
+
+ $ok = is_undef($foo);
+
+ $ok = is_string($foo);
+ $ok = is_number($foo);
+
+ $ok = is_glob($foo);
+
+ $ok = is_ref($foo);
+ $t = ref_type($foo);
+ $ok = is_ref($foo, "HASH");
+
+ $ok = is_blessed($foo);
+ $ok = is_blessed($foo, "IO::Handle");
+ $c = blessed_class($foo);
+ $ok = is_strictly_blessed($foo, "IO::Pipe::End");
+ $ok = is_able($foo, ["print", "flush"]);
+
+=head1 DESCRIPTION
+
+This module provides various type-testing functions. These are intended
+for functions that, unlike most Perl code, care what type of data they
+are operating on. For example, some functions wish to behave differently
+depending on the type of their arguments (like overloaded functions
+in C++).
+
+These functions only provide type classification; they do not enforce
+type restrictions. Type enforcement may, of course, be built using
+these classification functions, but the reader's attention is drawn
+to L<Params::Validate>.
+
+=cut
+
+package Params::Classify;
+
+use warnings;
+use strict;
+
+use Exporter;
+use Scalar::Util qw(blessed looks_like_number reftype);
+
+our $VERSION = "0.000";
+
+our @ISA = qw(Exporter);
+
+our @EXPORT_OK = qw(
+ scalar_class
+ is_undef
+ is_string is_number
+ is_glob
+ is_ref ref_type
+ is_blessed blessed_class is_strictly_blessed is_able
+);
+
+=head1 TYPE CLASSIFICATION
+
+This module divides up scalar values into the following classes:
+
+=over
+
+=item *
+
+undef
+
+=item *
+
+string (defined ordinary scalar)
+
+=item *
+
+typeglob
+
+=item *
+
+reference to unblessed object (further classified by physical data type
+of the referenced object)
+
+=item *
+
+reference to blessed object (further classified by class blessed into)
+
+=back
+
+These classes are mutually exclusive and should be exhaustive. This
+classification has been chosen as the most useful when one wishes to
+discriminate between types of scalar. Other classifications are possible.
+(For example, the two reference classes are distinguished by a feature of
+the referenced object; Perl does not internally treat this as a feature
+of the reference.)
+
+=head1 FUNCTIONS
+
+Each of these functions takes one scalar argument to be tested, possibly
+with other arguments specifying details of the test. Any scalar value is
+acceptable for the argument to be tested (called ARG below). Each "is_"
+function returns a simple boolean result.
+
+=head2 Classification
+
+=over
+
+=item scalar_class(ARG)
+
+Determines which of the five classes described above ARG falls into.
+Returns "UNDEF", "STRING", "GLOB", "REF", or "BLESSED" accordingly.
+
+=cut
+
+sub scalar_class($) {
+ my($arg) = @_;
+ my $type = reftype(\$arg);
+ if($type eq "SCALAR") {
+ $type = defined($arg) ? "STRING" : "UNDEF";
+ } elsif($type eq "REF") {
+ $type = "BLESSED" if defined(blessed($arg));
+ }
+ $type;
+}
+
+=back
+
+=head2 The Undefined Value
+
+=over
+
+=item is_undef(ARG)
+
+Returns true iff ARG is C<undef>. This is precisely equivalent to
+C<!defined(ARG)>, and is included for completeness.
+
+=cut
+
+sub is_undef($) {
+ my($arg) = @_;
+ !defined($arg);
+}
+
+=back
+
+=head2 Strings
+
+=over
+
+=item is_string(ARG)
+
+This returns true iff ARG is defined and is an ordinary scalar value
+(not a reference or a typeglob). This is what one usually thinks of as a
+string in Perl. In fact, any scalar (including C<undef> and references)
+can be coerced to a string, but if you're trying to classify a scalar
+then you don't want to do that.
+
+=cut
+
+sub is_string($) {
+ my($arg) = @_;
+ defined($arg) && reftype(\$arg) eq "SCALAR";
+}
+
+=item is_number(ARG)
+
+This returns true iff ARG is defined and an ordinary scalar (i.e.,
+satisfies C<is_string> above) and is an acceptable number to Perl.
+This is what one usually thinks of as a number.
+
+This differs from C<looks_like_number> (see
+L<Scalar::Util/looks_like_number>; also L<perlapi/looks_like_number>
+for a lower-level description) in excluding C<undef>, typeglobs,
+and references. Why C<looks_like_number> returns true for C<undef>
+or typeglobs is anybody's guess. References, if treated as numbers,
+evaluate to the address in memory that they reference; this is useful
+for comparing references for equality, but it is not otherwise useful
+to treat references as numbers. Blessed references may have overloaded
+numeric operators, but if so then they don't necessarily behave like
+ordinary numbers.
+
+Note that simple (C<is_string>-satisfying) scalars may have independent
+numeric and string values, despite the usual pretence that they have
+only one value. Such a scalar is deemed to be a number if I<either> it
+already has a numeric value (e.g., was generated by a numeric literal or
+an arithmetic computation) I<or> its string value has acceptable syntax
+for a number (so it can be converted). Where a scalar has separate
+numeric and string values (see L<Scalar::Util/dualvar>), it is possible
+for it to have an acceptable numeric value while its string value does
+I<not> have acceptable numeric syntax. Be careful to use such a value
+only in a numeric context, if you are using it as a number. C<0+ARG>
+is sufficient to collapse it to an ordinary number if you want the
+numeric value in string form.
+
+=cut
+
+# Note: looks_like_number() returning true for undef and typeglobs appears
+# to be a bug in perl. It's present in v5.8.3 and reported as bug ID
+# #27606. Without this bug we wouldn't need the defined($arg) test below.
+
+sub is_number($) {
+ my($arg) = @_;
+ defined($arg) && reftype(\$arg) eq "SCALAR" && looks_like_number($arg);
+}
+
+=back
+
+=head2 Typeglobs
+
+=over
+
+=item is_glob(ARG)
+
+Returns true iff ARG is a typeglob. Yes, typeglobs fit into scalar
+variables.
+
+=cut
+
+sub is_glob($) {
+ my($arg) = @_;
+ reftype(\$arg) eq "GLOB";
+}
+
+=back
+
+=head2 References to Unblessed Objects
+
+=over
+
+=item is_ref(ARG)
+
+Returns true iff ARG is a reference to an unblessed object. If it
+is, then the referenced data type can be determined using C<ref_type>
+(see below), which will return a string such as "HASH" or "SCALAR".
+
+=item ref_type(ARG)
+
+Returns C<undef> if ARG is not a reference to an unblessed object.
+Otherwise, determines what type of object is referenced. Returns
+"SCALAR", "ARRAY", "HASH", "CODE", "FORMAT", or "IO" accordingly.
+
+Note that, unlike C<ref>, this does not distinguish between different
+types of referenced scalar. A reference to a string and a reference to
+a reference will both return "SCALAR". Consequently, what C<ref_type>
+returns for a particular reference will not change due to changes in
+the value of the referent, except for the referent being blessed.
+
+=item is_ref(ARG, TYPE)
+
+TYPE must be a string. Returns true iff ARG is a reference to an
+unblessed object of type TYPE, as determined by C<ref_type> (above).
+Possible TYPEs are "SCALAR", "ARRAY", "HASH", "CODE", "FORMAT", and "IO".
+
+=cut
+
+{
+ my %xlate_reftype = (
+ REF => "SCALAR",
+ SCALAR => "SCALAR",
+ LVALUE => "SCALAR",
+ GLOB => "SCALAR",
+ ARRAY => "ARRAY",
+ HASH => "HASH",
+ CODE => "CODE",
+ FORMAT => "FORMAT",
+ IO => "IO",
+ );
+
+ sub ref_type($) {
+ my($arg) = @_;
+ my $reftype = reftype($arg);
+ return undef unless
+ defined($reftype) && !defined(blessed($arg));
+ my $xlated_reftype = $xlate_reftype{$reftype};
+ die "unknown reftype `$reftype', please update me"
+ unless defined $xlated_reftype;
+ $xlated_reftype;
+ }
+
+ sub is_ref($;$) {
+ my($arg, $type) = @_;
+ my $reftype = reftype($arg);
+ return undef unless
+ defined($reftype) && !defined(blessed($arg));
+ return 1 if !defined($type);
+ my $xlated_reftype = $xlate_reftype{$reftype};
+ die "unknown reftype `$reftype', please update me"
+ unless defined $xlated_reftype;
+ $xlated_reftype eq $type;
+ }
+}
+
+=back
+
+=head2 References to Blessed Objects
+
+=over
+
+=item is_blessed(ARG)
+
+Returns true iff ARG is a reference to a blessed object. If it is,
+then the class into which the object was blessed can be determined using
+C<blessed_class> (see below).
+
+=item is_blessed(ARG, CLASS)
+
+CLASS must be a string. Returns true iff ARG is a reference to a blessed
+object that claims to be an instance of CLASS (via its C<isa> method;
+see L<perlobj/isa>).
+
+=cut
+
+sub is_blessed($;$) {
+ my($arg, $class) = @_;
+ defined(blessed($arg)) && (!defined($class) || $arg->isa($class));
+}
+
+=item blessed_class(ARG)
+
+Returns C<undef> if ARG is not a reference to a blessed object.
+Otherwise, returns the class into which the object is blessed.
+
+C<ref> (see L<perlfunc/ref>) gives the same result on references
+to blessed objects, but different results on other types of value.
+C<blessed_class> is actually identical to C<Scalar::Util::blessed>
+(see L<Scalar::Util/blessed>).
+
+=cut
+
+*blessed_class = \&blessed;
+
+=item is_strictly_blessed(ARG)
+
+Returns true iff ARG is a reference to a blessed object, identically
+to C<is_blessed>. This exists only for symmetry; the useful form of
+C<is_strictly_blessed> appears below.
+
+=item is_strictly_blessed(ARG, CLASS)
+
+CLASS must be a string. Returns true iff ARG is a reference to an object
+blessed into class CLASS exactly. Because this excludes subclasses,
+this is rarely what one wants, but there are some specialised occasions
+where it is useful.
+
+=cut
+
+sub is_strictly_blessed($;$) {
+ my($arg, $class) = @_;
+ my $blessed = blessed($arg);
+ defined($blessed) && (!defined($class) || $blessed eq $class);
+}
+
+=item is_able(ARG, METHODS)
+
+METHODS must be either a single method name or a reference to an array
+of method names. Each method name is a string. Returns true iff ARG is
+a reference to a blessed object that claims to implement the specified
+methods (via its C<can> method; see L<perlobj/can>). This interface
+check is often more appropriate than a direct ancestry check (such as
+C<is_blessed> performs).
+
+=cut
+
+sub is_able($$) {
+ my($arg, $methods) = @_;
+ return 0 unless defined blessed $arg;
+ foreach my $method (ref($methods) eq "" ? $methods : @$methods) {
+ return 0 unless $arg->can($method);
+ }
+ 1;
+}
+
+=back
+
+=head1 BUGS
+
+Probably ought to handle C<Params::Validate>'s scalar type specification
+system, which makes much the same distinctions.
+
+=head1 SEE ALSO
+
+L<Params::Validate>,
+L<Scalar::Util>
+
+=head1 AUTHOR
+
+Andrew Main (Zefram) <zefram@fysh.org>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004 Andrew Main (Zefram) <zefram@fysh.org>
+
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
Added: packages/libparams-classify-perl/branches/upstream/current/t/blessed.t
===================================================================
--- packages/libparams-classify-perl/branches/upstream/current/t/blessed.t 2004-06-10 14:06:08 UTC (rev 116)
+++ packages/libparams-classify-perl/branches/upstream/current/t/blessed.t 2004-06-10 14:07:01 UTC (rev 117)
@@ -0,0 +1,39 @@
+use Test::More tests => 129;
+
+@B::ISA = qw(A);
+
+sub A::flange { }
+
+BEGIN {
+ use_ok "Params::Classify", qw(
+ is_blessed blessed_class is_strictly_blessed is_able
+ );
+}
+
+my @class_names = qw(UNIVERSAL qwerty A B);
+my @method_names = qw(qwerty can isa print flange);
+
+sub test_blessed($$@) {
+ my($scalar, $class, $isb, @expect) = @_;
+ is(blessed_class($scalar), $class);
+ is(!!is_blessed($scalar), !!$isb);
+ is(!!is_strictly_blessed($scalar), !!$isb);
+ foreach my $cn (@class_names) {
+ my $state = shift(@expect);
+ is(!!is_blessed($scalar, $cn), !!$state);
+ is(!!is_strictly_blessed($scalar, $cn), $state eq 2);
+ }
+ foreach my $mn (@method_names) {
+ is(!!is_able($scalar, $mn), !!shift(@expect));
+ }
+}
+
+test_blessed(undef, undef, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+test_blessed("foo", undef, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+test_blessed(123, undef, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+test_blessed(*STDOUT, undef, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+test_blessed({}, undef, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+test_blessed(bless({}, "main"), "main", 1, 1, 0, 0, 0, 0, 1, 1, 0, 0);
+test_blessed(bless({}, "A"), "A", 1, 1, 0, 2, 0, 0, 1, 1, 0, 1);
+test_blessed(bless({}, "B"), "B", 1, 1, 0, 1, 2, 0, 1, 1, 0, 1);
Added: packages/libparams-classify-perl/branches/upstream/current/t/classify.t
===================================================================
--- packages/libparams-classify-perl/branches/upstream/current/t/classify.t 2004-06-10 14:06:08 UTC (rev 116)
+++ packages/libparams-classify-perl/branches/upstream/current/t/classify.t 2004-06-10 14:07:01 UTC (rev 117)
@@ -0,0 +1,30 @@
+use Test::More tests => 71;
+
+BEGIN {
+ use_ok "Params::Classify", qw(
+ scalar_class is_undef is_string
+ is_number is_glob is_ref is_blessed
+ );
+}
+
+sub test_scalar_classification($$$$$$$$) {
+ my($scalar, $class, $iu, $is, $in, $ig, $ir, $ib) = @_;
+ is(scalar_class($scalar), $class);
+ is(!!is_undef($scalar), !!$iu);
+ is(!!is_string($scalar), !!$is);
+ is(!!is_number($scalar), !!$in);
+ is(!!is_glob($scalar), !!$ig);
+ is(!!is_ref($scalar), !!$ir);
+ is(!!is_blessed($scalar), !!$ib);
+}
+
+test_scalar_classification(undef, "UNDEF", 1, 0, 0, 0, 0, 0);
+test_scalar_classification("", "STRING", 0, 1, 0, 0, 0, 0);
+test_scalar_classification("abc", "STRING", 0, 1, 0, 0, 0, 0);
+test_scalar_classification(123, "STRING", 0, 1, 1, 0, 0, 0);
+test_scalar_classification(0, "STRING", 0, 1, 1, 0, 0, 0);
+test_scalar_classification("0 but true", "STRING", 0, 1, 1, 0, 0, 0);
+test_scalar_classification("1ab", "STRING", 0, 1, 0, 0, 0, 0);
+test_scalar_classification(*STDOUT, "GLOB", 0, 0, 0, 1, 0, 0);
+test_scalar_classification({}, "REF", 0, 0, 0, 0, 1, 0);
+test_scalar_classification(bless({}, "main"), "BLESSED", 0, 0, 0, 0, 0, 1);
Added: packages/libparams-classify-perl/branches/upstream/current/t/ref.t
===================================================================
--- packages/libparams-classify-perl/branches/upstream/current/t/ref.t 2004-06-10 14:06:08 UTC (rev 116)
+++ packages/libparams-classify-perl/branches/upstream/current/t/ref.t 2004-06-10 14:07:01 UTC (rev 117)
@@ -0,0 +1,32 @@
+use Test::More tests => 109;
+
+BEGIN { use_ok "Params::Classify", qw(is_ref ref_type); }
+
+format foo =
+.
+
+my $foo = "";
+
+sub test_ref_type($$) {
+ my($scalar, $reftype) = @_;
+ is(ref_type($scalar), $reftype);
+ is(!!is_ref($scalar), !!$reftype);
+ $reftype = "" if !defined($reftype);
+ foreach my $type (qw(SCALAR ARRAY HASH CODE FORMAT IO qwerty)) {
+ is(!!is_ref($scalar, $type), $type eq $reftype);
+ }
+}
+
+test_ref_type(undef, undef);
+test_ref_type("foo", undef);
+test_ref_type(123, undef);
+test_ref_type(*STDOUT, undef);
+test_ref_type(bless({}, "main"), undef);
+
+test_ref_type(\1, "SCALAR");
+test_ref_type(\\1, "SCALAR");
+test_ref_type(\pos($foo), "SCALAR");
+test_ref_type([], "ARRAY");
+test_ref_type({}, "HASH");
+test_ref_type(\&is, "CODE");
+test_ref_type(*foo{FORMAT}, "FORMAT");