Skip to content

Commit 99965cf

Browse files
Implement whence for SEEK.
1 parent e0ea6c7 commit 99965cf

3 files changed

Lines changed: 73 additions & 9 deletions

File tree

.gitignore

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,3 +19,22 @@ pm_to_blib
1919
Test-MockFile-*
2020
Test-MockFile-*.tar.gz
2121
.DS_Store
22+
23+
# VIM - https://github.com/github/gitignore/blob/main/Global/Vim.gitignore
24+
# Swap
25+
[._]*.s[a-v][a-z]
26+
!*.svg # comment out if you don't need vector files
27+
[._]*.sw[a-p]
28+
[._]s[a-rt-v][a-z]
29+
[._]ss[a-gi-z]
30+
[._]sw[a-p]
31+
# Session
32+
Session.vim
33+
Sessionx.vim
34+
# Temporary
35+
.netrwhist
36+
*~
37+
# Auto-generated tag files
38+
tags
39+
# Persistent undo
40+
[._]*.un~

lib/Test/MockFile/FileHandle.pm

Lines changed: 22 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -402,10 +402,6 @@ Arguments passed are:C<( $self, $pos, $whence )>
402402
403403
Moves the location of our current tell location.
404404
405-
B<$whence is UNIMPLEMENTED>: Open a ticket in
406-
L<github|https://github.com/cpanelinc/Test-MockFile/issues> if you need
407-
this feature.
408-
409405
No L<perldoc
410406
documentation|http://perldoc.perl.org/perltie.html#Tying-FileHandles>
411407
exists on this method.
@@ -415,17 +411,34 @@ exists on this method.
415411
sub SEEK {
416412
my ( $self, $pos, $whence ) = @_;
417413

418-
if ($whence) {
419-
die('Unimplemented');
420-
}
421414
my $file_size = length $self->{'data'}->{'contents'};
422415
return if $file_size < $pos;
423416

424-
$self->{'tell'} = $pos;
417+
my $new_pos;
418+
419+
my $SEEK_SET = 0;
420+
my $SEEK_CUR = 1;
421+
my $SEEK_END = 2;
425422

426-
return $pos == 0 ? '0 but true' : $pos;
423+
if ($whence == $SEEK_SET) {
424+
$new_pos = $pos;
425+
} elsif ($whence == $SEEK_CUR) {
426+
$new_pos = $self->{'tell'} + $pos;
427+
} elsif ($whence == $SEEK_END) {
428+
$new_pos = $file_size + $pos;
429+
} else {
430+
die('Invalid whence value');
431+
}
432+
433+
if ($new_pos < 0 || $new_pos > $file_size) {
434+
return 0;
435+
}
436+
437+
$self->{'tell'} = $new_pos;
438+
return $new_pos == 0 ? '0 but true' : $new_pos;
427439
}
428440

441+
429442
=head2 TELL
430443
431444
Returns the numeric location we are in the file. The C<TELL> tells us

t/sysopen.t

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,21 @@ is( \%Test::MockFile::files_being_mocked, {}, "No mock files are in cache" ) or
8383
ok( seek( $fh, 0, 0 ), 0, "Seek to start of file returns true" );
8484
is( sysseek( $fh, 0, 0 ), "0 but true", "sysseek to start of file returns '0 but true' to make it so." );
8585
ok( sysseek( $fh, 0, 0 ), "sysseek to start of file returns true when checked with ok()" );
86+
87+
ok( sysseek( $fh, 5, 0 ), "sysseek to position 5 returns true." );
88+
ok( sysseek( $fh, 10, 1 ), "Seek 10 bytes forward from the current position." );
89+
is( sysseek( $fh, 0, 1 ), 15, "Current position is 15 bytes from start." );
90+
91+
$buf = "";
92+
is( sysread( $fh, $buf, 2, 0 ), 2, "Read 2 bytes from current position (10)." );
93+
is( $buf, "PQ", "Line is as expected." );
94+
95+
ok( sysseek( $fh, -5, 2 ), "Seek 5 bytes back from end of file." );
96+
is( sysseek( $fh, 0, 1 ), 46, "Current position is 46 bytes from start." );
97+
98+
$buf = "";
99+
is( sysread( $fh, $buf, 3, 0 ), 3, "Read 3 bytes from current position (46)." );
100+
is( $buf, "vwx", "Line is as expected." );
86101
}
87102

88103
{
@@ -122,6 +137,23 @@ is( \%Test::MockFile::files_being_mocked, {}, "No mock files are in cache" ) or
122137
is( sysseek( $fh, 0, 0 ), "0 but true", "sysseek to start of file returns '0 but true' to make it so." );
123138
ok( sysseek( $fh, 0, 0 ), "sysseek to start of file returns true when checked with ok()" );
124139

140+
ok( sysseek( $fh, 5, 0 ), "sysseek to position 5 returns true." );
141+
ok( sysseek( $fh, 10, 1 ), "Seek 10 bytes forward from the current position." );
142+
is( sysseek( $fh, 0, 1 ), 15, "Current position is 15 bytes from start." );
143+
144+
$buf = "";
145+
is( sysread( $fh, $buf, 2, 0 ), 2, "Read 2 bytes from current position (10)." );
146+
is( $buf, "PQ", "Line is as expected." );
147+
148+
ok( sysseek( $fh, -5, 2 ), "Seek 5 bytes back from end of file." );
149+
is( sysseek( $fh, 0, 1 ), 46, "Current position is 46 bytes from start." );
150+
151+
$buf = "";
152+
is( sysread( $fh, $buf, 3, 0 ), 3, "Read 3 bytes from current position (46)." );
153+
is( $buf, "vwx", "Line is as expected." );
154+
155+
like( dies { sysseek( $fh, 10, 3 ) }, qr/Invalid whence value/, "Dies when given an invalid whence value." );
156+
125157
close $fh;
126158
undef $bar;
127159
}

0 commit comments

Comments
 (0)