Author: timbo Date: Thu Sep 27 13:53:04 2007 New Revision: 10007 Modified: dbi/trunk/Changes dbi/trunk/lib/DBD/ExampleP.pm dbi/trunk/lib/DBD/File.pm dbi/trunk/lib/DBI/ProfileData.pm dbi/trunk/t/05thrclone.t dbi/trunk/t/19fhtrace.t dbi/trunk/t/50dbm.t dbi/trunk/t/85gofer.t
Log: Fix for VMS thanks to Peter (Stig) Edwards (http://rt.cpan.org/Public/Bug/Display.html?id=29492). Modified: dbi/trunk/Changes ============================================================================== --- dbi/trunk/Changes (original) +++ dbi/trunk/Changes Thu Sep 27 13:53:04 2007 @@ -46,6 +46,7 @@ Fixed t/05thrclone.t to work with Test::More >= 0.71 thanks to Jerry D. Hedden and Michael G Schwern. + Fixed DBI for VMS thanks to Peter (Stig) Edwards. =head2 Changes in DBI 1.59 (svn rev 9874), 23rd August 2007 Modified: dbi/trunk/lib/DBD/ExampleP.pm ============================================================================== --- dbi/trunk/lib/DBD/ExampleP.pm (original) +++ dbi/trunk/lib/DBD/ExampleP.pm Thu Sep 27 13:53:04 2007 @@ -152,6 +152,11 @@ opendir($dh, $dir) or return $dbh->set_err(int($!), "Failed to open directory $dir: $!"); while (defined(my $item = readdir($dh))) { + if ($^O eq 'VMS') { + # if on VMS then avoid warnings from catdir if you use a file + # (not a dir) as the item below + next if $item !~ /\.dir$/oi; + } my $file = ($haveFileSpec) ? File::Spec->catdir($dir,$item) : $item; next unless -d $file; my($dev, $ino, $mode, $nlink, $uid) = lstat($file); Modified: dbi/trunk/lib/DBD/File.pm ============================================================================== --- dbi/trunk/lib/DBD/File.pm (original) +++ dbi/trunk/lib/DBD/File.pm Thu Sep 27 13:53:04 2007 @@ -139,6 +139,11 @@ $driver = 'File'; } while (defined($file = readdir($dirh))) { + if ($^O eq 'VMS') { + # if on VMS then avoid warnings from catdir if you use a file + # (not a dir) as the file below + next if $file !~ /\.dir$/oi; + } my $d = $haveFileSpec ? File::Spec->catdir($dir, $file) : "$dir/$file"; # allow current dir ... it can be a data_source too Modified: dbi/trunk/lib/DBI/ProfileData.pm ============================================================================== --- dbi/trunk/lib/DBI/ProfileData.pm (original) +++ dbi/trunk/lib/DBI/ProfileData.pm Thu Sep 27 13:53:04 2007 @@ -196,9 +196,15 @@ if ($self->{DeleteFiles}) { my $newfilename = $filename . ".deleteme"; + if ($^O eq 'VMS') { + # VMS default filesystem can only have one period + $newfilename = $filename . 'deleteme'; + } # will clobber an existing $newfilename rename($filename, $newfilename) or croak "Can't rename($filename, $newfilename): $!"; + # On a versioned filesystem we want old versions to be removed + 1 while (unlink $filename); $filename = $newfilename; } @@ -219,7 +225,13 @@ push @files_to_delete, $filename if $self->{DeleteFiles}; } - unlink $_ or warn "Can't delete '$_': $!" for @files_to_delete; + for (@files_to_delete){ + # for versioned file systems + 1 while (unlink $_); + if(-e $_){ + warn "Can't delete '$_': $!"; + } + } # discard node_lookup now that all files are read delete $self->{_node_lookup}; Modified: dbi/trunk/t/05thrclone.t ============================================================================== --- dbi/trunk/t/05thrclone.t (original) +++ dbi/trunk/t/05thrclone.t Thu Sep 27 13:53:04 2007 @@ -27,6 +27,7 @@ use_ok('DBI'); +$DBI::PurePerl = $DBI::PurePerl; # just to silence used only once warning $DBI::neat_maxlen = 12345; cmp_ok($DBI::neat_maxlen, '==', 12345, '... assignment of neat_maxlen was successful'); Modified: dbi/trunk/t/19fhtrace.t ============================================================================== --- dbi/trunk/t/19fhtrace.t (original) +++ dbi/trunk/t/19fhtrace.t Thu Sep 27 13:53:04 2007 @@ -188,7 +188,10 @@ # read new file size and verify its different # my $newfsz = (stat $tracefd)[7]; -ok(($filesz != $newfsz), '... regular fh: trace_msg'); +SKIP: { + skip 'on VMS autoflush using select does not work', 1 if $^O eq 'VMS'; + ok(($filesz != $newfsz), '... regular fh: trace_msg'); +} $dbh->trace(undef, "STDOUT"); # close $trace_file ok(-f $trace_file, '... regular fh: file successfully changed'); Modified: dbi/trunk/t/50dbm.t ============================================================================== --- dbi/trunk/t/50dbm.t (original) +++ dbi/trunk/t/50dbm.t Thu Sep 27 13:53:04 2007 @@ -3,6 +3,7 @@ use strict; use File::Path; +use File::Spec; use Test::More; use Cwd; use Config qw(%Config); @@ -64,7 +65,7 @@ } } -my $dir = getcwd().'/test_output'; +my $dir = File::Spec->catdir(getcwd(),'test_output'); rmtree $dir; mkpath $dir; Modified: dbi/trunk/t/85gofer.t ============================================================================== --- dbi/trunk/t/85gofer.t (original) +++ dbi/trunk/t/85gofer.t Thu Sep 27 13:53:04 2007 @@ -80,7 +80,7 @@ or next; # XXX temporary restrictions, hopefully - if ($^O eq 'MSWin32') { + if ( ($^O eq 'MSWin32') || ($^O eq 'VMS') ) { # stream needs Fcntl macro F_GETFL for non-blocking # and pipe seems to hang on some windows systems next if $transport eq 'stream' or $transport eq 'pipeone';
