Skip to content

Commit

Permalink
Allow selection of an encoding on slurp/spew in Mojo::File
Browse files Browse the repository at this point in the history
  • Loading branch information
genio committed Jul 29, 2023
1 parent 1343054 commit 2d4ba87
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 6 deletions.
23 changes: 18 additions & 5 deletions lib/Mojo/File.pm
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ use File::stat ();
use File::Temp ();
use IO::File ();
use Mojo::Collection;
use Mojo::Util qw(decode encode);

our @EXPORT_OK = ('curfile', 'path', 'tempdir', 'tempfile');

Expand Down Expand Up @@ -127,23 +128,26 @@ sub sibling {
}

sub slurp {
my $self = shift;
my ($self, $encoding) = @_;

CORE::open my $file, '<', $$self or croak qq{Can't open file "$$self": $!};
my $ret = my $content = '';
while ($ret = $file->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
croak qq{Can't read from file "$$self": $!} unless defined $ret;

return $content;
return $encoding ? decode($encoding, $content) : $content;
}

sub spurt {
my ($self, $content) = (shift, join '', @_);
sub spew {
my ($self, $content, $encoding) = @_;
$content = encode($encoding, $content) if $encoding;
CORE::open my $file, '>', $$self or croak qq{Can't open file "$$self": $!};
($file->syswrite($content) // -1) == length $content or croak qq{Can't write to file "$$self": $!};
return $self;
}

sub spurt { shift->spew(join '', @_) }

sub stat { File::stat::stat(${shift()}) }

sub tap { shift->Mojo::Base::tap(@_) }
Expand Down Expand Up @@ -471,8 +475,17 @@ Return a new L<Mojo::File> object relative to the directory part of the path.
=head2 slurp
my $bytes = $path->slurp;
my $chars = $path->slurp('UTF-8');
Read all data at once from the file. If an encoding is provided, an attempt will be made to decode the content.
=head2 spew
$path = $path->spew($bytes);
$path = $path->spew($chars, $encoding);
Read all data at once from the file.
Write all data at once to the file. If an encoding is provided, an attempt to encode the content will be made prior
to writing.
=head2 spurt
Expand Down
23 changes: 22 additions & 1 deletion t/mojo/file.t
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ use File::Basename qw(basename dirname);
use File::Spec::Functions qw(abs2rel canonpath catfile rel2abs splitdir);
use File::Temp;
use Mojo::File qw(curfile path tempdir tempfile);
use Mojo::Util qw(encode);
use Mojo::Util qw(decode encode);

subtest 'Constructor' => sub {
is(Mojo::File->new, canonpath(getcwd), 'same path');
Expand Down Expand Up @@ -342,4 +342,25 @@ subtest 'I/O' => sub {
}
};

subtest 'I/O with Encoding' => sub {
my $dir = tempdir;
my $file = $dir->child('test.txt')->spew('♥1', 'UTF-8');
is $file->slurp('UTF-8'), '♥1', 'right content';
is decode('UTF-8', $file->slurp()), '♥1', 'right content';
is $file->spew('works too!')->slurp, 'works too!', 'right content';
$file->spew(encode('UTF-8', '♥1'));
is $file->slurp('UTF-8'), '♥1', 'right content';
is decode('UTF-8', $file->slurp()), '♥1', 'right content';
{
eval { $file->spew('♥1') };
like $@, qr/Wide character/, 'right error';
}
{
no warnings 'redefine';
local *IO::Handle::syswrite = sub { $! = 0; 5 };
eval { $file->spew("just\nworks!") };
like $@, qr/Can't write to file ".*/, 'right error';
}
};

done_testing();

0 comments on commit 2d4ba87

Please sign in to comment.