diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 1999-10-27 14:06:44 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-10-27 14:06:44 +0000 |
commit | 1ae6be1c7649fa55b3105031a58ffe146fa4f2fd (patch) | |
tree | 2bdf0dec28a91f5b0e5b8445ed6c203c64e7268a /lib | |
parent | 10a675193b1a7d3751e2d04a91c294c6be9dfaf7 (diff) | |
parent | 2b260de0f3727bc62519897f69d6f752c97d8502 (diff) | |
download | perl-1ae6be1c7649fa55b3105031a58ffe146fa4f2fd.tar.gz |
Integrate with Sarathy; manual resolve on regcomp.c conflicts
(Ilya's changes won).
p4raw-id: //depot/cfgperl@4468
Diffstat (limited to 'lib')
-rw-r--r-- | lib/File/Path.pm | 9 | ||||
-rw-r--r-- | lib/Time/Local.pm | 49 | ||||
-rw-r--r-- | lib/attributes.pm | 47 |
3 files changed, 75 insertions, 30 deletions
diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 729037294b..a82fd8004e 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -2,15 +2,14 @@ package File::Path; =head1 NAME -File::Path - create or remove a series of directories +File::Path - create or remove directory trees =head1 SYNOPSIS -C<use File::Path> + use File::Path; -C<mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);> - -C<rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);> + mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711); + rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1); =head1 DESCRIPTION diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm index f2f1672941..7a10d98ba7 100644 --- a/lib/Time/Local.pm +++ b/lib/Time/Local.pm @@ -3,8 +3,19 @@ require 5.000; require Exporter; use Carp; -@ISA = qw(Exporter); -@EXPORT = qw(timegm timelocal); +@ISA = qw( Exporter ); +@EXPORT = qw( timegm timelocal ); +@EXPORT_OK = qw( $no_range_check ); + +sub import { + my $package = shift; + my @args; + for (@_) { + $no_range_check = 1, next if $_ eq 'no_range_check'; + push @args, $_; + } + Time::Local->export_to_level(1, $package, @args); +} # Set up constants $SEC = 1; @@ -51,7 +62,6 @@ sub timelocal { my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR; - my($lday,$gday) = ($lt[7],$gt[7]); if($lt[5] > $gt[5]) { $tzsec -= $DAY; } @@ -73,11 +83,13 @@ sub timelocal { sub cheat { $year = $_[5]; $month = $_[4]; - croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0; - croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1; - croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0; - croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0; - croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0; + unless ($no_range_check) { + croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0; + croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1; + croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0; + croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0; + croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0; + } $guess = $^T; @g = gmtime($guess); $lastguess = ""; @@ -137,6 +149,27 @@ the values provided. While the day of the month is expected to be in the range 1..31, the month should be in the range 0..11. This is consistent with the values returned from localtime() and gmtime(). +Also worth noting is the ability to disable the range checking that +would normally occur on the input $sec, $min, $hours, $mday, and $mon +values. You can do this by setting $Time::Local::no_range_check = 1, +or by invoking the module with C<use Time::Local 'no_range_check'>. +This enables you to abuse the terminology somewhat and gain the +flexibilty to do things like: + + use Time::Local qw( no_range_check ); + + # The 365th day of 1999 + print scalar localtime timelocal 0,0,0,365,0,99; + + # The twenty thousandth day since 1970 + print scalar localtime timelocal 0,0,0,20000,0,70; + + # And even the 10,000,000th second since 1999! + print scalar localtime timelocal 10000000,0,0,1,0,99; + +Your mileage may vary when trying this trick with minutes and hours, +and it doesn't work at all for months. + Strictly speaking, the year should also be specified in a form consistent with localtime(), i.e. the offset from 1900. In order to make the interpretation of the year easier for humans, diff --git a/lib/attributes.pm b/lib/attributes.pm index e49204fc76..09f355139f 100644 --- a/lib/attributes.pm +++ b/lib/attributes.pm @@ -1,9 +1,10 @@ package attributes; -$VERSION = 0.01; +$VERSION = 0.02; -#@EXPORT_OK = qw(get reftype); -#@EXPORT = (); +@EXPORT_OK = qw(get reftype); +@EXPORT = (); +%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); use strict; @@ -29,8 +30,10 @@ sub carp { BEGIN { bootstrap } sub import { - @_ > 2 && ref $_[2] or - croak 'Usage: use '.__PACKAGE__.' $home_stash, $ref, @attrlist'; + @_ > 2 && ref $_[2] or do { + require Exporter; + goto &Exporter::import; + }; my (undef,$home_stash,$svref,@attrs) = @_; my $svtype = uc reftype($svref); @@ -82,12 +85,7 @@ sub get ($) { ; } -#sub export { -# require Exporter; -# goto &Exporter::import; -#} -# -#sub require_version { goto &UNIVERSAL::VERSION } +sub require_version { goto &UNIVERSAL::VERSION } 1; __END__ @@ -106,13 +104,16 @@ attributes - get/set subroutine or variable attributes use attributes (); # optional, to get subroutine declarations my @attrlist = attributes::get(\&foo); + use attributes 'get'; # import the attributes::get subroutine + my @attrlist = get \&foo; + =head1 DESCRIPTION Subroutine declarations and definitions may optionally have attribute lists associated with them. (Variable C<my> declarations also may, but see the warning below.) Perl handles these declarations by passing some information about the call site and the thing being declared along with the attribute -list to this module. In particular, first example above is equivalent to +list to this module. In particular, the first example above is equivalent to the following: use attributes __PACKAGE__, \&foo, 'method'; @@ -187,7 +188,7 @@ empty. If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>) to raise a fatal exception. If it can find an appropriate package name for a class method lookup, it will include the results from a C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in -L"Package-specific Attribute Handling"> below. +L<"Package-specific Attribute Handling"> below. Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned. =item reftype @@ -196,13 +197,11 @@ This routine expects a single parameter--a reference to a subroutine or variable. It returns the built-in type of the referenced variable, ignoring any package into which it might have been blessed. This can be useful for determining the I<type> value which forms part of -the method names described in L"Package-specific Attribute Handling"> below. +the method names described in L<"Package-specific Attribute Handling"> below. =back -Note that these routines are I<not> exported. This is primarily because -the C<use> mechanism which would normally import them is already in use -by Perl itself to implement the C<sub : attributes> syntax. +Note that these routines are I<not> exported by default. =head2 Package-specific Attribute Handling @@ -289,6 +288,20 @@ Some examples of syntactically invalid attribute lists (with annotation): Y2::north # "Y2::north" not a simple identifier foo + bar # "+" neither a comma nor whitespace +=head1 EXPORTS + +=head2 Default exports + +None. + +=head2 Available exports + +The routines C<get> and C<reftype> are exportable. + +=head2 Export tags defined + +The C<:ALL> tag will get all of the above exports. + =head1 EXAMPLES Here are some samples of syntactically valid declarations, with annotation |