Skip Menu |
 

This queue is for tickets about the PathTools CPAN distribution.

Report information
The Basics
Id: 8762
Status: resolved
Priority: 0/
Queue: PathTools

People
Owner: Nobody in particular
Requestors: RSOD [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



MIME-Version: 1.0
X-Mailer: MIME-tools 5.411 (Entity 5.404)
Subject: Patch to avoid modifying @_ unnecessarily
Content-Type: multipart/mixed; boundary="----------=_1102414661-31415-2"
Content-Length: 0
Content-Type: text/plain
Content-Disposition: inline
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: iso-8859-1
Content-Length: 438
Download (untitled) / with headers
text/plain 438b
Hi, I just finished applying optimizations similar to this to CPANPLUS, and noticed that, for instance, 35% of the time spent in catdir() is in "my $self = shift". The attached patch modifies several routines that need not modify @_ to avoid doing so; this provides a performance improvement when many thousands of calls are made (something I've actually encountered recently). Tested under OS X (I don't have VMS access, sorry). - R.
Content-Type: application/octet-stream; name="PathTools-noshift.diff"
Content-Disposition: inline; filename="PathTools-noshift.diff"
Content-Transfer-Encoding: base64
Content-Length: 4711
diff -purd PathTools-3.01.orig/lib/File/Spec/Cygwin.pm PathTools-3.01/lib/File/Spec/Cygwin.pm --- PathTools-3.01.orig/lib/File/Spec/Cygwin.pm Mon Sep 6 20:37:47 2004 +++ PathTools-3.01/lib/File/Spec/Cygwin.pm Tue Dec 7 02:03:47 2004 @@ -76,8 +76,7 @@ variables are tainted, they are not used my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - my $self = shift; - $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' ); + $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' ); } =back diff -purd PathTools-3.01.orig/lib/File/Spec/Mac.pm PathTools-3.01/lib/File/Spec/Mac.pm --- PathTools-3.01.orig/lib/File/Spec/Mac.pm Mon Sep 6 20:37:47 2004 +++ PathTools-3.01/lib/File/Spec/Mac.pm Tue Dec 7 02:05:21 2004 @@ -373,8 +373,7 @@ directory on your startup volume. my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - my $self = shift; - $tmpdir = $self->_tmpdir( $ENV{TMPDIR} ); + $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} ); } =item updir @@ -642,7 +641,7 @@ Based on code written by Shigio Yamaguch # maybe this should be done in canonpath() ? sub _resolve_updirs { - my $path = shift @_; + my $path = $_[0]; my $proceed; # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file" diff -purd PathTools-3.01.orig/lib/File/Spec/OS2.pm PathTools-3.01/lib/File/Spec/OS2.pm --- PathTools-3.01.orig/lib/File/Spec/OS2.pm Mon Sep 6 20:37:47 2004 +++ PathTools-3.01/lib/File/Spec/OS2.pm Tue Dec 7 02:06:05 2004 @@ -37,21 +37,19 @@ sub _cwd { my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - my $self = shift; - $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)}, + $tmpdir = $_[0]->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)}, '/tmp', '/' ); } sub catdir { - my $self = shift; - my @args = @_; + my @args = @_[1..$#_]; foreach (@args) { tr[\\][/]; # append a backslash to each argument unless it has one there $_ .= "/" unless m{/$}; } - return $self->canonpath(join('', @args)); + return $_[0]->canonpath(join('', @args)); } sub canonpath { diff -purd PathTools-3.01.orig/lib/File/Spec/Unix.pm PathTools-3.01/lib/File/Spec/Unix.pm --- PathTools-3.01.orig/lib/File/Spec/Unix.pm Mon Sep 6 20:37:47 2004 +++ PathTools-3.01/lib/File/Spec/Unix.pm Tue Dec 7 02:10:51 2004 @@ -68,9 +68,7 @@ trailing slash :-) =cut sub catdir { - my $self = shift; - - $self->canonpath(join('/', @_, '')); # '' because need a trailing '/' + $_[0]->canonpath(join('/', @_[1..$#_], '')); # '' because need a trailing '/' } =item catfile @@ -151,8 +149,7 @@ sub _tmpdir { sub tmpdir { return $tmpdir if defined $tmpdir; - my $self = shift; - $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp" ); + $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" ); } =item updir @@ -171,8 +168,7 @@ directory. (Does not strip symlinks, onl =cut sub no_upwards { - my $self = shift; - return grep(!/^\.{1,2}\Z(?!\n)/s, @_); + return grep(!/^\.{1,2}\Z(?!\n)/s, @_[1..$#_]); } =item case_tolerant @@ -219,8 +215,7 @@ join is the same as catfile. =cut sub join { - my $self = shift; - return $self->catfile(@_); + return $_[0]->catfile(@_[1..$#_]); } =item splitpath diff -purd PathTools-3.01.orig/lib/File/Spec/VMS.pm PathTools-3.01/lib/File/Spec/VMS.pm --- PathTools-3.01.orig/lib/File/Spec/VMS.pm Mon Sep 6 20:37:47 2004 +++ PathTools-3.01/lib/File/Spec/VMS.pm Tue Dec 7 02:07:23 2004 @@ -297,8 +297,7 @@ is tainted, it is not used. my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - my $self = shift; - $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} ); + $tmpdir = $_[0]->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} ); } =item updir (override) diff -purd PathTools-3.01.orig/lib/File/Spec/Win32.pm PathTools-3.01/lib/File/Spec/Win32.pm --- PathTools-3.01.orig/lib/File/Spec/Win32.pm Mon Sep 6 20:37:47 2004 +++ PathTools-3.01/lib/File/Spec/Win32.pm Tue Dec 7 02:07:53 2004 @@ -59,8 +59,7 @@ variables are tainted, they are not used my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - my $self = shift; - $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)}, + $tmpdir = $_[0]->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)}, 'SYS:/temp', 'C:/temp', '/tmp', @@ -93,14 +92,13 @@ sub catfile { } sub catdir { - my $self = shift; - my @args = @_; + my @args = @_[1..$#_]; foreach (@args) { tr[/][\\]; # append a backslash to each argument unless it has one there $_ .= "\\" unless m{\\$}; } - return $self->canonpath(join('', @args)); + return $_[0]->canonpath(join('', @args)); } sub path {
Content-Type: text/plain
Content-Disposition: inline
Content-Transfer-Encoding: binary
MIME-Version: 1.0
X-Mailer: MIME-tools 5.415 (Entity 5.415)
X-RT-Original-Encoding: iso-8859-1
Content-Length: 273
Download (untitled) / with headers
text/plain 273b
Hi Richard, Thanks for the [old] patch - I've applied it in the cases where it didn't seem too contortive, which ended up just being the tmpdir() instances. Even there, though, it won't make much difference, because all the calls after the first one are cached. -Ken


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.