----------------
____________________________________________________________________________
+[ 4386] By: gsar on 1999/10/15 05:45:36
+ Log: various little goofs in change#4385
+ Branch: perl
+ ! win32/include/dirent.h win32/win32.c
+____________________________________________________________________________
+[ 4385] By: gsar on 1999/10/15 04:49:09
+ Log: win32_*dir() cleanup; win32_readdir() iterates as necessary
+ rather than win32_opendir() reading all files up front (untested)
+ Branch: perl
+ ! win32/include/dirent.h win32/win32.c
+____________________________________________________________________________
+[ 4384] By: gsar on 1999/10/15 01:34:09
+ Log: Benchmark notes (from Barrie Slaymaker <barries@slaysys.com>)
+ Branch: perl
+ ! lib/Benchmark.pm pod/perldelta.pod
+____________________________________________________________________________
+[ 4383] By: gsar on 1999/10/15 01:22:32
+ Log: include info about Perl Mongers in perlfaq2 (from David H. Adler
+ <dha@panix.com>)
+ Branch: perl
+ ! pod/perlfaq2.pod
+____________________________________________________________________________
+[ 4382] By: gsar on 1999/10/15 01:14:22
+ Log: From: jand@ActiveState.com (Jan Dubois)
+ Date: Fri, 15 Oct 1999 01:14:23 +0200
+ Message-ID: <380f61ae.18202914@smtprelay.t-online.de>
+ Subject: [PATCH 5.005_61] Prevent "Out of memory" error in POSIX's strftime()
+ Branch: perl
+ ! ext/POSIX/POSIX.xs
+____________________________________________________________________________
+[ 4381] By: jhi on 1999/10/14 22:11:36
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> XSUB.h cop.h embed.h embed.pl ext/File/Glob/bsd_glob.c
+ !> lib/Time/Local.pm perl.c perlapi.c pod/perlop.pod pp_ctl.c
+ !> proto.h scope.c scope.h t/op/runlevel.t util.c win32/Makefile
+ !> win32/makefile.mk
+____________________________________________________________________________
+[ 4380] By: jhi on 1999/10/14 22:08:22
+ Log: Warn inside character classes about unknown backslash escapes
+ (that are not caught earlier because of being completely unknown,
+ such as \m), such as \z (because they make do sense inside regexen,
+ but not inside character classes).
+ Branch: cfgperl
+ ! pod/perldelta.pod pod/perldiag.pod regcomp.c
+ ! t/pragma/warn/regcomp
+____________________________________________________________________________
+[ 4379] By: gsar on 1999/10/14 18:26:56
+ Log: clarify significance of parens for "x" (from M.J.T. Guy
+ <mjtg@cus.cam.ac.uk>)
+ Branch: perl
+ ! pod/perlop.pod
+____________________________________________________________________________
+[ 4378] By: gsar on 1999/10/14 18:25:20
+ Log: make timelocal work better when time is close to the epoch
+ east of GMT (from Keiki SATOH <kki@wakusei.ne.jp>)
+ Branch: perl
+ ! lib/Time/Local.pm
+____________________________________________________________________________
+[ 4377] By: gsar on 1999/10/14 18:15:11
+ Log: integrate cfgperl contents into mainline
+ Branch: perl
+ +> ext/DB_File/hints/sco.pl
+ !> MANIFEST hints/aix.sh hints/linux.sh hints/svr5.sh
+ !> pod/perldelta.pod pod/perldiag.pod pod/perlop.pod
+ !> pod/perlre.pod regcomp.c t/op/re_tests t/pragma/warn/regcomp
+____________________________________________________________________________
+[ 4376] By: gsar on 1999/10/14 17:47:35
+ Log: fix POPSTACK panics that ensued from bad interaction between
+ runlevels and stack of stacks (change#3988 done right);
+ basically, we pop the runlevel if the stacklevel is not the
+ same one we started the runlevel with
+ Branch: perl
+ ! cop.h perl.c pp_ctl.c t/op/runlevel.t util.c
+____________________________________________________________________________
+[ 4375] By: gsar on 1999/10/14 15:54:48
+ Log: avoid warnings
+ Branch: perl
+ ! ext/File/Glob/bsd_glob.c
+____________________________________________________________________________
+[ 4374] By: jhi on 1999/10/14 10:08:44
+ Log: Warn about false ranges like \d-\w (see the change #4355).
+ The invalid ranges (b-a) warning message also enhanced.
+ Branch: cfgperl
+ ! pod/perldelta.pod pod/perldiag.pod regcomp.c t/op/re_tests
+ ! t/pragma/warn/regcomp
+____________________________________________________________________________
+[ 4373] By: gsar on 1999/10/14 03:49:54
+ Log: File::Glob fixes for Windows
+ Branch: perl
+ ! XSUB.h ext/File/Glob/bsd_glob.c win32/Makefile
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 4372] By: gsar on 1999/10/14 02:21:31
+ Log: avoid inefficiency in change#3386 (every longjmp() was followed
+ by an avoidable call to setjmp())
+ Branch: perl
+ ! embed.h embed.pl perl.c perlapi.c pod/perldelta.pod pp_ctl.c
+ ! proto.h scope.c scope.h
+____________________________________________________________________________
+[ 4371] By: jhi on 1999/10/13 21:17:17
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> op.c pod/perldelta.pod
+____________________________________________________________________________
+[ 4370] By: gsar on 1999/10/13 18:08:45
+ Log: misc tweaks
+ Branch: perl
+ ! op.c pod/perldelta.pod
+____________________________________________________________________________
+[ 4369] By: jhi on 1999/10/13 16:18:58
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+____________________________________________________________________________
+[ 4368] By: gsar on 1999/10/13 16:14:16
+ Log: pod nits from various perl porters
+ Branch: perl
+ ! pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+____________________________________________________________________________
+[ 4367] By: jhi on 1999/10/13 12:10:30
+ Log: From: Vlad Harchev <hvv@hippo.ru>
+ To: perl5-porters@perl.org
+ Subject: [ID 19991013.002] fix for 'perlop.pod' shipped with perl5.00503
+ Date: Wed, 13 Oct 1999 15:48:59 +0500 (SAMST)
+ Message-Id: <Pine.LNX.4.10.9910131546580.3542-100000@localhost.localdomain>
+ Branch: cfgperl
+ ! pod/perlop.pod
+____________________________________________________________________________
+[ 4366] By: gsar on 1999/10/13 08:11:11
+ Log: typos and language goofs pointed out by Hugo van der Sanden
+ <hv@crypt.compulink.co.uk>
+ Branch: perl
+ ! pod/perldelta.pod pod/perldiag.pod
+____________________________________________________________________________
+[ 4365] By: jhi on 1999/10/13 07:27:44
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ +> ext/File/Glob/Changes ext/File/Glob/Glob.pm
+ +> ext/File/Glob/Glob.xs ext/File/Glob/Makefile.PL
+ +> ext/File/Glob/TODO ext/File/Glob/bsd_glob.c
+ +> ext/File/Glob/bsd_glob.h ext/NDBM_File/hints/sco.pl
+ +> t/lib/glob-basic.t t/lib/glob-global.t t/lib/glob-taint.t
+ !> Changes MANIFEST README.win32 ext/ODBM_File/hints/sco.pl
+ !> lib/perl5db.pl op.c pod/perldelta.pod pod/perlfaq8.pod
+ !> pod/perlfunc.pod pod/perlop.pod pod/perlport.pod t/op/glob.t
+ !> t/op/readdir.t t/op/taint.t t/pragma/overload.t util.c
+____________________________________________________________________________
+[ 4364] By: gsar on 1999/10/13 07:06:04
+ Log: debugger tweak (from M.J.T. Guy <mjtg@cus.cam.ac.uk>)
+ Branch: perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 4363] By: jhi on 1999/10/13 07:03:43
+ Log: From: Mike Hopkirk (hops) <hops@scoot.pdev.sco.com>
+ To: perl5-porters@perl.org
+ Subject: [ID 19991012.002] Latest UnixWare7 (svr5.sh) hints file
+ Date: Tue, 12 Oct 1999 19:48:11 -0700 (PDT)
+ Message-Id: <199910130248.TAA14636@scoot.pdev.sco.com>
+ Branch: cfgperl
+ ! hints/svr5.sh
+____________________________________________________________________________
+[ 4362] By: jhi on 1999/10/13 06:57:16
+ Log: Add DB_File hint for SCO ODT.
+ From: hops@sco.com
+ To: perl5-porters@perl.org
+ Subject: [ID 19991012.004] Build patch for perl5.005_03 on ODT3 ( 3.2v4.2)
+ Date: Tue, 12 Oct 1999 20:16:04 PDT
+ Message-Id: <199910122016.aa18415@charmstr.pdev.sco.com>
+ Branch: cfgperl
+ + ext/DB_File/hints/sco.pl
+ ! MANIFEST
+____________________________________________________________________________
+[ 4361] By: gsar on 1999/10/13 06:56:08
+ Log: PL_numeric_radix used without being defined (from Ilya
+ Zakharevich)
+ Branch: perl
+ ! util.c
+____________________________________________________________________________
+[ 4360] By: gsar on 1999/10/13 06:43:03
+ Log: use libdbm.nfs.a if available (libdbm.a is missing dbmclose())
+ From: hops@sco.com
+ Date: Tue, 12 Oct 1999 20:16:04 PDT
+ Message-Id: <199910122016.aa18415@charmstr.pdev.sco.com>
+ Subject: [ID 19991012.004] Build patch for perl5.005_03 on ODT3 ( 3.2v4.2)
+ Branch: perl
+ + ext/NDBM_File/hints/sco.pl
+ ! MANIFEST ext/ODBM_File/hints/sco.pl
+____________________________________________________________________________
+[ 4359] By: gsar on 1999/10/13 06:34:53
+ Log: various pod tweaks (from M.J.T. Guy <mjtg@cus.cam.ac.uk>)
+ Branch: perl
+ ! README.win32 pod/perlfaq8.pod pod/perlfunc.pod pod/perlop.pod
+ ! pod/perlport.pod
+____________________________________________________________________________
+[ 4358] By: gsar on 1999/10/12 19:10:27
+ Log: perldelta updates
+ Branch: perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 4357] By: gsar on 1999/10/12 17:11:18
+ Log: update perldelta for change#4356
+ Branch: perl
+ ! Changes pod/perldelta.pod
+____________________________________________________________________________
[ 4356] By: gsar on 1999/10/12 16:53:31
Log: add File::BSDGlob as File::Glob and load it at compile-time
if perl was built with -DPERL_INTERNAL_GLOB
** If there is a better way to make it portable, go ahead by
** all means.
*/
- if ( ( len > 0 && len < sizeof(tmpbuf) )
- || ( len == 0 && strlen(fmt) == 0 ) ) {
+ if ((len > 0 && len < sizeof(tmpbuf)) || (len == 0 && *fmt == '\0'))
ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
- } else {
+ else {
/* Possibly buf overflowed - try again with a bigger buf */
- int bufsize = strlen(fmt) + sizeof(tmpbuf);
+ int fmtlen = strlen(fmt);
+ int bufsize = fmtlen + sizeof(tmpbuf);
char* buf;
int buflen;
New(0, buf, bufsize, char);
- while( buf ) {
+ while (buf) {
buflen = strftime(buf, bufsize, fmt, &mytm);
- if ( buflen > 0 && buflen < bufsize ) break;
+ if (buflen > 0 && buflen < bufsize)
+ break;
+ /* heuristic to prevent out-of-memory errors */
+ if (bufsize > 100*fmtlen) {
+ Safefree(buf);
+ buf = NULL;
+ break;
+ }
bufsize *= 2;
Renew(buf, bufsize, char);
}
- if ( buf ) {
+ if (buf) {
ST(0) = sv_2mortal(newSVpvn(buf, buflen));
Safefree(buf);
- } else {
- ST(0) = sv_2mortal(newSVpvn(tmpbuf, len));
}
+ else
+ ST(0) = sv_2mortal(newSVpvn(tmpbuf, len));
}
}
Caching is off by default, as it can (usually slightly) decrease
accuracy and does not usually noticably affect runtimes.
+=head1 EXAMPLES
+
+For example,
+
+ use Benchmark;$x=3;cmpthese(-5,{a=>sub{$x*$x},b=>sub{$x**2}})
+
+outputs something like this:
+
+ Benchmark: running a, b, each for at least 5 CPU seconds...
+ a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743)
+ b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452)
+ Rate b a
+ b 1574945/s -- -59%
+ a 3835056/s 144% --
+
+while
+
+ use Benchmark;
+ $x=3;
+ $r=timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}},'none');
+ cmpthese($r);
+
+outputs something like this:
+
+ Rate b a
+ b 1559428/s -- -62%
+ a 4152037/s 166% --
+
+
=head1 INHERITANCE
Benchmark inherits from no other class, except of course
=item Benchmark
+Overall, Benchmark results exhibit lower average error and better timing
+accuracy.
+
You can now run tests for I<n> seconds instead of guessing the right
number of tests to run: e.g. timethese(-5, ...) will run each
code for at least 5 CPU seconds. Zero as the "number of repetitions"
means "for at least 3 CPU seconds". The output format has also
changed. For example:
-use Benchmark;$x=3;timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}})
+ use Benchmark;$x=3;timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}})
will now output something like this:
-Benchmark: running a, b, each for at least 5 CPU seconds...
- a: 5 wallclock secs ( 5.77 usr + 0.00 sys = 5.77 CPU) @ 200551.91/s (n=1156516)
- b: 4 wallclock secs ( 5.00 usr + 0.02 sys = 5.02 CPU) @ 159605.18/s (n=800686)
+ Benchmark: running a, b, each for at least 5 CPU seconds...
+ a: 5 wallclock secs ( 5.77 usr + 0.00 sys = 5.77 CPU) @ 200551.91/s (n=1156516)
+ b: 4 wallclock secs ( 5.00 usr + 0.02 sys = 5.02 CPU) @ 159605.18/s (n=800686)
New features: "each for at least N CPU seconds...", "wallclock secs",
and the "@ operations/CPU second (n=operations)".
-change#4265,4266,4292
-[TODO - Barrie Slaymaker <barries@slaysys.com>]
+timethese() now returns a reference to a hash of Benchmark objects containing
+the test results, keyed on the names of the tests.
+
+timethis() now returns the iterations field in the Benchmark result object
+instead of 0.
+
+timethese(), timethis(), and the new cmpthese() (see below) can also take
+a format specifier of 'none' to suppress output.
+
+A new function countit() is just like timeit() except that it takes a
+TIME instead of a COUNT.
+
+A new function cmpthese() prints a chart comparing the results of each test
+returned from a timethese() call. For each possible pair of tests, the
+percentage speed difference (iters/sec or seconds/iter) is shown.
+
+For other details, see L<Benchmark>.
=item Devel::Peek
=head1 NAME
-perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.31 $, $Date: 1999/04/14 03:46:19 $)
+perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.32 $, $Date: 1999/10/14 18:46:09 $)
=head1 DESCRIPTION
Read the perlbug(1) man page (perl5.004 or later) for more information.
-=head2 What is perl.com?
+=head2 What is perl.com? Perl Mongers? pm.org? perl.org?
The perl.com domain is owned by Tom Christiansen, who created it as a
public service long before perl.org came about. Despite the name, it's a
http://conference.perl.com/
http://reference.perl.com/
+Perl Mongers is an advocacy organization for the Perl language. For
+details, see the Perl Mongers web site at http://www.perlmongers.org/.
+
+Perl Mongers uses the pm.org domain for services related to Perl user
+groups. See the Perl user group web site at http://www.pm.org/ for more
+information about joining, starting, or requesting services for a Perl
+user group.
+
+Perl Mongers also maintains the perl.org domain to provide general
+support services to the Perl community, including the hosting of mailing
+lists, web sites, and other services. The web site
+http://www.perl.org/ is a general advocacy site for the Perl language,
+and there are many other sub-domains for special topics, such as
+
+ http://history.perl.org/
+ http://bugs.perl.org/
+ http://www.news.perl.org/
+
=head1 AUTHOR AND COPYRIGHT
Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
print PM <<"END";
package $module;
+require 5.005_62;
use strict;
END
if( $opt_X || $opt_c || $opt_A ){
# we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
print PM <<'END';
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+our @EXPORT_OK;
END
}
else{
# will want Carp.
print PM <<'END';
use Carp;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+our @EXPORT_OK;
END
}
}
# Determine @ISA.
-my $myISA = '@ISA = qw(Exporter'; # We seem to always want this.
+my $myISA = 'our @ISA = qw(Exporter'; # We seem to always want this.
$myISA .= ' DynaLoader' unless $opt_X; # no XS
$myISA .= ');';
print PM "\n$myISA\n\n";
# This allows declaration use $module ':all';
# If you do not need this, moving things directly into \@EXPORT or \@EXPORT_OK
# will save memory.
-%EXPORT_TAGS = ( 'all' => [ qw(
+our %EXPORT_TAGS = ( 'all' => [ qw(
@exported_names
) ] );
-\@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } );
-
-\@EXPORT = (
+our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } );
+our \@EXPORT = qw(
+ @const_names
);
-\$VERSION = '$TEMPLATE_VERSION';
+our \$VERSION = '$TEMPLATE_VERSION';
END
# to the AUTOLOAD in AutoLoader.
my \$constname;
+ our $AUTOLOAD;
(\$constname = \$AUTOLOAD) =~ s/.*:://;
croak "&$module::constant not defined" if \$constname eq 'constant';
my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
-// dirent.h
+/* dirent.h */
-// djl
-// Provide UNIX compatibility
+/* djl
+ * Provide UNIX compatibility
+ */
#ifndef _INC_DIRENT
#define _INC_DIRENT
-//
-// NT versions of readdir(), etc
-// From the MSDOS implementation
-//
+/*
+ * NT versions of readdir(), etc
+ * From the MSDOS implementation
+ */
-// Directory entry size
+/* Directory entry size */
#ifdef DIRSIZ
#undef DIRSIZ
#endif
#define DIRSIZ(rp) (sizeof(struct direct))
-// needed to compile directory stuff
+/* needed to compile directory stuff */
#define DIRENT direct
-// structure of a directory entry
+/* structure of a directory entry */
typedef struct direct
{
- long d_ino; // inode number (not used by MS-DOS)
- int d_namlen; // Name length
- char d_name[257]; // file name
+ long d_ino; /* inode number (not used by MS-DOS) */
+ long d_namlen; /* name length */
+ char d_name[257]; /* file name */
} _DIRECT;
-// structure for dir operations
+/* structure for dir operations */
typedef struct _dir_struc
{
- char *start; // Starting position
- char *curr; // Current position
- long size; // Size of string table
- long nfiles; // number if filenames in table
- struct direct dirstr; // Directory structure to return
+ char *start; /* starting position */
+ char *curr; /* current position */
+ long size; /* allocated size of string table */
+ long nfiles; /* number of filenames in table */
+ struct direct dirstr; /* directory structure to return */
+ void* handle; /* system handle */
+ char *end; /* position after last filename */
} DIR;
#if 0 /* these have moved to win32iop.h */
int win32_closedir(DIR *dirp);
#endif
-#endif //_INC_DIRENT
+#endif /* _INC_DIRENT */
win32_opendir(char *filename)
{
dTHXo;
- DIR *p;
+ DIR *dirp;
long len;
long idx;
char scanname[MAX_PATH+3];
HANDLE fh;
char buffer[MAX_PATH*2];
WCHAR wbuffer[MAX_PATH];
- char* ptr;
+ char* ptr;
len = strlen(filename);
if (len > MAX_PATH)
return NULL;
/* Get us a DIR structure */
- Newz(1303, p, 1, DIR);
- if (p == NULL)
- return NULL;
+ Newz(1303, dirp, 1, DIR);
/* Create the search pattern */
strcpy(scanname, filename);
else {
fh = FindFirstFileA(scanname, &aFindData);
}
+ dirp->handle = fh;
if (fh == INVALID_HANDLE_VALUE) {
+ DWORD err = GetLastError();
/* FindFirstFile() fails on empty drives! */
- if (GetLastError() == ERROR_FILE_NOT_FOUND)
- return p;
- Safefree( p);
+ switch (err) {
+ case ERROR_FILE_NOT_FOUND:
+ return dirp;
+ case ERROR_NO_MORE_FILES:
+ case ERROR_PATH_NOT_FOUND:
+ errno = ENOENT;
+ break;
+ case ERROR_NOT_ENOUGH_MEMORY:
+ errno = ENOMEM;
+ break;
+ default:
+ errno = EINVAL;
+ break;
+ }
+ Safefree(dirp);
return NULL;
}
ptr = aFindData.cFileName;
}
idx = strlen(ptr)+1;
- New(1304, p->start, idx, char);
- if (p->start == NULL)
- Perl_croak_nocontext("opendir: malloc failed!\n");
- strcpy(p->start, ptr);
- p->nfiles++;
-
- /* loop finding all the files that match the wildcard
- * (which should be all of them in this directory!).
- * the variable idx should point one past the null terminator
- * of the previous string found.
- */
- while (USING_WIDE()
- ? FindNextFileW(fh, &wFindData)
- : FindNextFileA(fh, &aFindData)) {
- if (USING_WIDE()) {
- W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer));
- }
- /* ptr is set above to the correct area */
- len = strlen(ptr);
- /* bump the string table size by enough for the
- * new name and it's null terminator
- */
- Renew(p->start, idx+len+1, char);
- if (p->start == NULL)
- Perl_croak_nocontext("opendir: malloc failed!\n");
- strcpy(&p->start[idx], ptr);
- p->nfiles++;
- idx += len+1;
- }
- FindClose(fh);
- p->size = idx;
- p->curr = p->start;
- return p;
+ if (idx < 256)
+ dirp->size = 128;
+ else
+ dirp->size = idx;
+ New(1304, dirp->start, dirp->size, char);
+ strcpy(dirp->start, ptr);
+ dirp->nfiles++;
+ dirp->end = dirp->curr = dirp->start;
+ dirp->end += idx;
+ return dirp;
}
DllExport struct direct *
win32_readdir(DIR *dirp)
{
- int len;
- static int dummy = 0;
+ long len;
if (dirp->curr) {
/* first set up the structure to return */
dirp->dirstr.d_namlen = len;
/* Fake an inode */
- dirp->dirstr.d_ino = dummy++;
+ dirp->dirstr.d_ino = dirp->curr - dirp->start;
- /* Now set up for the nDllExport call to readdir */
+ /* Now set up for the next call to readdir */
dirp->curr += len + 1;
- if (dirp->curr >= (dirp->start + dirp->size)) {
- dirp->curr = NULL;
+ if (dirp->curr >= dirp->end) {
+ dTHXo;
+ char* ptr;
+ BOOL res;
+ WIN32_FIND_DATAW wFindData;
+ WIN32_FIND_DATAA aFindData;
+ char buffer[MAX_PATH*2];
+
+ /* finding the next file that matches the wildcard
+ * (which should be all of them in this directory!).
+ */
+ if (USING_WIDE()) {
+ res = FindNextFileW(dirp->handle, &wFindData);
+ if (res) {
+ W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer));
+ ptr = buffer;
+ }
+ }
+ else {
+ res = FindNextFileA(dirp->handle, &aFindData);
+ if (res)
+ ptr = aFindData.cFileName;
+ }
+ if (res) {
+ long endpos = dirp->end - dirp->start;
+ long newsize = endpos + strlen(ptr) + 1;
+ /* bump the string table size by enough for the
+ * new name and it's null terminator */
+ while (newsize > dirp->size) {
+ long curpos = dirp->curr - dirp->start;
+ dirp->size *= 2;
+ Renew(dirp->start, dirp->size, char);
+ dirp->curr = dirp->start + curpos;
+ }
+ strcpy(dirp->start + endpos, ptr);
+ dirp->end = dirp->start + newsize;
+ dirp->nfiles++;
+ }
+ else
+ dirp->curr = NULL;
}
-
return &(dirp->dirstr);
}
else
DllExport long
win32_telldir(DIR *dirp)
{
- return (long) dirp->curr;
+ return (dirp->curr - dirp->start);
}
/* Seekdir moves the string pointer to a previously saved position
- *(Saved by telldir).
+ * (returned by telldir).
*/
DllExport void
win32_seekdir(DIR *dirp, long loc)
{
- dirp->curr = (char *)loc;
+ dirp->curr = dirp->start + loc;
}
/* Rewinddir resets the string pointer to the start */
win32_closedir(DIR *dirp)
{
dTHXo;
+ if (dirp->handle != INVALID_HANDLE_VALUE)
+ FindClose(dirp->handle);
Safefree(dirp->start);
Safefree(dirp);
return 1;
https://perl5.git.perl.org / perl5.git / commitdiff