1 2use strict; 3use warnings; 4use Test::More; 5use File::Spec; 6 7 8eval { require Storable; }; 9unless($INC{'Storable.pm'}) { 10 plan skip_all => 'no Storable.pm'; 11} 12 13# Initialise filenames and check they're there 14 15my $SrcFile = File::Spec->catfile('t', 'desertnet.src'); 16my $XMLFile = File::Spec->catfile('t', 'desertnet5.xml'); 17 18unless(-e $SrcFile) { 19 plan skip_all => 'test data missing'; 20} 21 22# Make sure we can write to the filesystem and check it uses the same 23# clock as the machine we're running on. 24 25my $t0 = time(); 26unless(open(XML, '>', $XMLFile)) { 27 plan skip_all => "can't create test file '$XMLFile': $!"; 28} 29close(XML); 30my $t1 = (stat($XMLFile))[9]; 31my $t2 = time(); 32 33if($t1 < $t0 or $t2 < $t1) { 34 plan skip_all => 'time moved backwards!' 35} 36 37plan tests => 7; 38 39############################################################################## 40# S U P P O R T R O U T I N E S 41############################################################################## 42 43############################################################################## 44# Copy a file 45# 46 47sub CopyFile { 48 my($src, $dst) = @_; 49 50 open(my $in, $src) or die "open(<$src): $!"; 51 local($/) = undef; 52 my $data = <$in>; 53 close($in); 54 55 open(my $out, '>', $dst) or die "open(>$dst): $!"; 56 print $out $data; 57 close($out); 58 59 return(1); 60} 61 62 63############################################################################## 64# Wait until the current time is greater than the supplied value 65# 66 67sub PassTime { 68 my($Target) = @_; 69 70 while(time <= $Target) { 71 sleep 1; 72 } 73} 74 75 76############################################################################## 77# T E S T R O U T I N E S 78############################################################################## 79 80use XML::Simple; 81 82# Initialise test data 83 84my $Expected = { 85 'server' => { 86 'sahara' => { 87 'osversion' => '2.6', 88 'osname' => 'solaris', 89 'address' => [ 90 '10.0.0.101', 91 '10.0.1.101' 92 ] 93 }, 94 'gobi' => { 95 'osversion' => '6.5', 96 'osname' => 'irix', 97 'address' => '10.0.0.102' 98 }, 99 'kalahari' => { 100 'osversion' => '2.0.34', 101 'osname' => 'linux', 102 'address' => [ 103 '10.0.0.103', 104 '10.0.1.103' 105 ] 106 } 107 } 108 }; 109 110ok(CopyFile($SrcFile, $XMLFile), 'copied source XML file'); 111$t0 = (stat($XMLFile))[9]; # Remember its timestamp 112 113 # Parse it with caching enabled 114my $opt = XMLin($XMLFile, cache => 'memcopy'); 115is_deeply($opt, $Expected, 'parsed expected data through the cache'); 116 117if ('VMS' eq $^O) { 118 1 while (unlink($XMLFile)); 119} else { 120 unlink($XMLFile); 121} 122ok(! -e $XMLFile, 'deleted the source XML file'); 123open(FILE, ">$XMLFile"); # Re-create it (empty) 124close(FILE); 125$t1 = $t0 - 1; 126eval { utime($t1, $t1, $XMLFile); }; # but wind back the clock 127$t2 = (stat($XMLFile))[9]; # Skip these tests if that didn't work 128SKIP: { 129 skip 'no utime', 2 if($t2 >= $t0); 130 131 $opt = XMLin($XMLFile, cache => 'memcopy'); 132 is_deeply($opt, $Expected, 'got what we expected from the cache'); 133 is(-s $XMLFile, 0, 'even though the source XML file is empty'); 134} 135 136 137PassTime(time()); # Ensure source file will be newer 138open(FILE, ">$XMLFile"); # Write some new data to the XML file 139print FILE qq(<opt one="1" two="2"></opt>\n); 140close(FILE); 141PassTime(time()); # Ensure current time later than file time 142 143 144 # Parse again with caching enabled 145$opt = XMLin($XMLFile, cache => 'memcopy'); 146is_deeply($opt, { one => 1, two => 2}, 'parsed expected data through cache'); 147 148$opt->{three} = 3; # Alter the returned structure 149 # Retrieve again from the cache 150my $opt2 = XMLin($XMLFile, cache => 'memcopy'); 151 152ok(!defined($opt2->{three}), 'cache not modified'); 153 154 155# Clean up and go 156 157unlink($XMLFile); 158exit(0); 159 160