Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
added experimental test_after/text_before methods to Mojo::DOM and ma…
…de all uses of syswrite more defensive
  • Loading branch information
kraih committed Jan 23, 2012
1 parent 683e11f commit def94d0
Show file tree
Hide file tree
Showing 8 changed files with 142 additions and 23 deletions.
4 changes: 3 additions & 1 deletion Changes
@@ -1,7 +1,9 @@
This file documents the revision history for Perl extension Mojolicious.

2.46 2012-01-21 00:00:00
2.46 2012-01-23 00:00:00
- Added EXPERIMENTAL request_timeout attribute to Mojo::UserAgent.
- Added EXPERIMENTAL text_after and text_before methods to Mojo::DOM.
- Improved all uses of syswrite to be more defensive. (bduggan, sri)
- Improved documentation.
- Improved tests.
- Fixed small parser bug in Mojo::Message::Response.
Expand Down
3 changes: 2 additions & 1 deletion lib/Mojo/Asset/File.pm
Expand Up @@ -58,7 +58,8 @@ sub add_chunk {
my $handle = $self->handle;
$handle->sysseek(0, SEEK_END);
$chunk //= '';
$handle->syswrite($chunk, length $chunk);
croak qq/Can't write to file asset: $!/
unless defined $handle->syswrite($chunk, length $chunk);
return $self;
}

Expand Down
3 changes: 2 additions & 1 deletion lib/Mojo/Asset/Memory.pm
Expand Up @@ -54,7 +54,8 @@ sub move_to {
my ($self, $path) = @_;
croak qq/Can't open file "$path": $!/
unless my $file = IO::File->new("> $path");
$file->syswrite($self->{content});
croak qq/Can't write to file "$path": $!/
unless defined $file->syswrite($self->{content});
return $self;
}

Expand Down
3 changes: 2 additions & 1 deletion lib/Mojo/Command.pm
Expand Up @@ -267,7 +267,8 @@ sub write_file {
# Write unbuffered
croak qq/Can't open file "$path": $!/
unless my $file = IO::File->new("> $path");
$file->syswrite($data);
croak qq/Can't write to file "$path": $!/
unless defined $file->syswrite($data);
say " [write] $path" unless $self->quiet;

return $self;
Expand Down
106 changes: 90 additions & 16 deletions lib/Mojo/DOM.pm
Expand Up @@ -49,7 +49,8 @@ sub new {

sub all_text {
my ($self, $trim) = @_;
return $self->_text($self->tree, 1, defined $trim ? $trim : 1);
my $tree = $self->tree;
return _text(_elements($tree), 1, _trim($tree, $trim));
}

sub append { shift->_add(1, @_) }
Expand Down Expand Up @@ -259,7 +260,39 @@ sub root {

sub text {
my ($self, $trim) = @_;
return $self->_text($self->tree, 0, defined $trim ? $trim : 1);
my $tree = $self->tree;
return _text(_elements($tree), 0, _trim($tree, $trim));
}

sub text_after {
my ($self, $trim) = @_;

# Find text elements after
return '' if (my $tree = $self->tree)->[0] eq 'root';
my (@elements, $started);
for my $e (@{_elements($tree->[3])}) {
++$started and next if $e eq $tree;
next unless $started;
last if $e->[0] eq 'tag';
push @elements, $e;
}

return _text(\@elements, 0, _trim($tree, $trim));
}

sub text_before {
my ($self, $trim) = @_;

# Find text elements before
return '' if (my $tree = $self->tree)->[0] eq 'root';
my @elements;
for my $e (@{_elements($tree->[3])}) {
last if $e eq $tree;
push @elements, $e;
@elements = () if $e->[0] eq 'tag';
}

return _text(\@elements, 0, _trim($tree, $trim));
}

sub to_xml { shift->[0]->render }
Expand Down Expand Up @@ -317,6 +350,11 @@ sub _add {
return $self;
}

sub _elements {
my $e = shift;
return [@$e[($e->[0] eq 'root' ? 1 : 4) .. $#$e]];
}

sub _parent {
my ($children, $parent) = @_;
my @new;
Expand All @@ -337,27 +375,18 @@ sub _parse {
}

sub _text {
my ($self, $tree, $recurse, $trim) = @_;

# Don't trim preformatted text
my $start = 4;
if ($tree->[0] eq 'root') { $start = 1 }
elsif ($trim) {
my $parent = $tree;
while ($parent->[0] eq 'tag') {
$trim = 0 if $parent->[1] eq 'pre';
last unless $parent = $parent->[3];
}
}
my ($elements, $recurse, $trim) = @_;

# Walk tree
my $text = '';
for my $e (@$tree[$start .. $#$tree]) {
for my $e (@$elements) {
my $type = $e->[0];

# Nested tag
my $content = '';
if ($type eq 'tag' && $recurse) { $content = $self->_text($e, 1, $trim) }
if ($type eq 'tag' && $recurse) {
$content = _text(_elements($e), 1, _trim($e, $trim));
}

# Text
elsif ($type eq 'text') {
Expand Down Expand Up @@ -385,6 +414,21 @@ sub _text {
return $text;
}

sub _trim {
my ($e, $trim) = @_;

# Deactivated
return 0 unless $trim = defined $trim ? $trim : 1;

# Detect "pre" tag
while ($e->[0] eq 'tag') {
return 0 if $e->[1] eq 'pre';
last unless $e = $e->[3];
}

return 1;
}

1;
__END__
Expand Down Expand Up @@ -620,6 +664,36 @@ this method is EXPERIMENTAL and might change without warning!
# "foo\nbaz\n"
$dom->parse("<div>foo\n<p>bar</p>baz\n</div>")->div->text(0);
=head2 C<text_after>
my $trimmed = $dom->text_after;
my $untrimmed = $dom->text_after(0);
Extract text content immediately after element, smart whitespace trimming is
activated by default. Note that this method is EXPERIMENTAL and might change
without warning!
# "baz"
$dom->parse("<div>foo\n<p>bar</p>baz\n</div>")->div->p->text_after;
# "baz\n"
$dom->parse("<div>foo\n<p>bar</p>baz\n</div>")->div->p->text_after(0);
=head2 C<text_before>
my $trimmed = $dom->text_before;
my $untrimmed = $dom->text_before(0);
Extract text content immediately before element, smart whitespace trimming is
activated by default. Note that this method is EXPERIMENTAL and might change
without warning!
# "foo"
$dom->parse("<div>foo\n<p>bar</p>baz\n</div>")->div->p->text_before;
# "foo\n"
$dom->parse("<div>foo\n<p>bar</p>baz\n</div>")->div->p->text_before(0);
=head2 C<to_xml>
my $xml = $dom->to_xml;
Expand Down
3 changes: 2 additions & 1 deletion lib/Mojo/Log.pm
Expand Up @@ -35,7 +35,8 @@ sub new {
my $self = shift;
return unless my $handle = $self->handle;
flock $handle, LOCK_EX;
$handle->syswrite($self->format(@_));
croak qq/Can't write to log: $!/
unless defined $handle->syswrite($self->format(@_));
flock $handle, LOCK_UN;
}
);
Expand Down
3 changes: 2 additions & 1 deletion lib/Mojo/Template.pm
Expand Up @@ -413,7 +413,8 @@ sub _write_file {
croak "Can't open file '$path': $!"
unless my $file = IO::File->new("> $path");
$output = encode $self->encoding, $output if $self->encoding;
$file->syswrite($output) or croak "Can't write to file '$path': $!";
croak qq/Can't write to file "$path": $!/
unless defined $file->syswrite($output);

return;
}
Expand Down
40 changes: 39 additions & 1 deletion t/mojo/dom.t
Expand Up @@ -2,7 +2,7 @@ use Mojo::Base -strict;

use utf8;

use Test::More tests => 694;
use Test::More tests => 718;

use ojo;
use Mojo::Util 'encode';
Expand Down Expand Up @@ -1883,6 +1883,44 @@ is $dom->div->pre->code->text(0), "like\n it\n really", 'right text';
is $dom->div->pre->code->all_text, "like\n it\n really", 'right text';
is $dom->div->pre->code->all_text(0), "like\n it\n really", 'right text';

# Text siblings
$dom = Mojo::DOM->new(<<EOF);
ok
<div>
looks<p>like</p>
thi<![CDATA[s]]>
<p>might</p><p>really</p>
<p>
just
</p>work
</div>
wow
EOF
is $dom->text_before, '', 'right text';
is $dom->text_before(0), '', 'right text';
is $dom->div->text_before, 'ok', 'right text';
is $dom->div->text_before(0), "ok\n", 'right text';
is $dom->div->p->[0]->text_before, 'looks', 'right text';
is $dom->div->p->[0]->text_before(0), "\n looks", 'right text';
is $dom->div->p->[1]->text_before, 'thi s', 'right text';
is $dom->div->p->[1]->text_before(0), "\n thi s\n ", 'right text';
is $dom->div->p->[2]->text_before, '', 'right text';
is $dom->div->p->[2]->text_before(0), '', 'right text';
is $dom->div->p->[3]->text_before, '', 'right text';
is $dom->div->p->[3]->text_before(0), "\n ", 'right text';
is $dom->text_after, '', 'right text';
is $dom->text_after(0), '', 'right text';
is $dom->div->text_after, 'wow', 'right text';
is $dom->div->text_after(0), "\nwow\n", 'right text';
is $dom->div->p->[0]->text_after, 'thi s', 'right text';
is $dom->div->p->[0]->text_after(0), "\n thi s\n ", 'right text';
is $dom->div->p->[1]->text_after, '', 'right text';
is $dom->div->p->[1]->text_after(0), '', 'right text';
is $dom->div->p->[2]->text_after, '', 'right text';
is $dom->div->p->[2]->text_after(0), "\n ", 'right text';
is $dom->div->p->[3]->text_after, 'work', 'right text';
is $dom->div->p->[3]->text_after(0), "work\n", 'right text';

# PoCo example with whitespace sensitive text
$dom = Mojo::DOM->new(<<EOF);
<?xml version="1.0" encoding="UTF-8"?>
Expand Down

0 comments on commit def94d0

Please sign in to comment.