Showing 125 changed files with 3965 additions and 2478 deletions
+2
mojo/README
... ...
@@ -0,0 +1,2 @@
1
+mojo-legacy 4.57
2
+https://github.com/jamadam/mojo-legacy
+10 -6
mojo/lib/Mojo.pm
... ...
@@ -15,10 +15,10 @@ has log  => sub { Mojo::Log->new };
15 15
 has ua   => sub {
16 16
   my $self = shift;
17 17
 
18
-  my $ua = Mojo::UserAgent->new->app($self);
18
+  my $ua = Mojo::UserAgent->new;
19
+  weaken $ua->server->app($self)->{app};
19 20
   weaken $self;
20 21
   $ua->on(error => sub { $self->log->error($_[1]) });
21
-  weaken $ua->{app};
22 22
 
23 23
   return $ua;
24 24
 };
... ...
@@ -27,7 +27,8 @@ sub new {
27 27
   my $self = shift->SUPER::new(@_);
28 28
 
29 29
   # Check if we have a log directory
30
-  my $home = $self->home->detect(ref $self);
30
+  my $home = $self->home;
31
+  $home->detect(ref $self) unless @{$home->parts};
31 32
   $self->log->path($home->rel_file('log/mojo.log'))
32 33
     if -w $home->rel_file('log');
33 34
 
... ...
@@ -58,6 +59,8 @@ sub _dict {
58 59
 
59 60
 1;
60 61
 
62
+=encoding utf8
63
+
61 64
 =head1 NAME
62 65
 
63 66
 Mojo - Duct tape for the HTML5 web!
... ...
@@ -92,7 +95,7 @@ frameworks. It provides all the basic tools and helpers needed to write
92 95
 simple web applications and higher level web frameworks, such as
93 96
 L<Mojolicious>.
94 97
 
95
-See L<Mojolicious> for more!
98
+See L<Mojolicious::Guides> for more!
96 99
 
97 100
 =head1 ATTRIBUTES
98 101
 
... ...
@@ -130,7 +133,7 @@ plugins, since non-blocking requests that are already in progress will
130 133
 interfere with new blocking ones.
131 134
 
132 135
   # Perform blocking request
133
-  my $body = $app->ua->get('example.com')->res->body;
136
+  say $app->ua->get('example.com')->res->body;
134 137
 
135 138
 =head1 METHODS
136 139
 
... ...
@@ -142,7 +145,8 @@ new ones.
142 145
   my $app = Mojo->new;
143 146
 
144 147
 Construct a new L<Mojo> application. Will automatically detect your home
145
-directory and set up logging to C<log/mojo.log> if there's a C<log> directory.
148
+directory if necessary and set up logging to C<log/mojo.log> if there's a
149
+C<log> directory.
146 150
 
147 151
 =head2 build_tx
148 152
 
+5 -3
mojo/lib/Mojo/Asset.pm
... ...
@@ -20,6 +20,8 @@ sub slurp   { croak 'Method "slurp" not implemented by subclass' }
20 20
 
21 21
 1;
22 22
 
23
+=encoding utf8
24
+
23 25
 =head1 NAME
24 26
 
25 27
 Mojo::Asset - HTTP content storage base class
... ...
@@ -58,7 +60,7 @@ Pretend file ends earlier.
58 60
 =head2 start_range
59 61
 
60 62
   my $start = $asset->start_range;
61
-  $asset    = $asset->start_range(0);
63
+  $asset    = $asset->start_range(3);
62 64
 
63 65
 Pretend file starts later.
64 66
 
... ...
@@ -96,9 +98,9 @@ False.
96 98
 
97 99
 =head2 is_range
98 100
 
99
-  my $success = $asset->is_range;
101
+  my $bool = $asset->is_range;
100 102
 
101
-Check if asset has a C<start_range> or C<end_range>.
103
+Check if asset has a L</"start_range"> or L</"end_range">.
102 104
 
103 105
 =head2 move_to
104 106
 
+9 -7
mojo/lib/Mojo/Asset/File.pm
... ...
@@ -26,7 +26,7 @@ has handle => sub {
26 26
   my $name = defined $path ? $path : $base;
27 27
   until ($handle->open($name, O_CREAT | O_EXCL | O_RDWR)) {
28 28
     croak qq{Can't open file "$name": $!} if defined $path || $! != $!{EEXIST};
29
-    $name = "$base." . md5_sum(time . $$ . rand 9999999);
29
+    $name = "$base." . md5_sum(time . $$ . rand 9 x 7);
30 30
   }
31 31
   $self->path($name);
32 32
 
... ...
@@ -140,6 +140,8 @@ sub slurp {
140 140
 
141 141
 1;
142 142
 
143
+=encoding utf8
144
+
143 145
 =head1 NAME
144 146
 
145 147
 Mojo::Asset::File - File storage for HTTP content
... ...
@@ -174,8 +176,8 @@ implements the following new ones.
174 176
 
175 177
 =head2 cleanup
176 178
 
177
-  my $cleanup = $file->cleanup;
178
-  $file       = $file->cleanup(1);
179
+  my $bool = $file->cleanup;
180
+  $file    = $file->cleanup($bool);
179 181
 
180 182
 Delete file automatically once it's not used anymore.
181 183
 
... ...
@@ -184,14 +186,14 @@ Delete file automatically once it's not used anymore.
184 186
   my $handle = $file->handle;
185 187
   $file      = $file->handle(IO::File->new);
186 188
 
187
-File handle, created on demand.
189
+Filehandle, created on demand.
188 190
 
189 191
 =head2 path
190 192
 
191 193
   my $path = $file->path;
192 194
   $file    = $file->path('/home/sri/foo.txt');
193 195
 
194
-File path used to create C<handle>, can also be automatically generated if
196
+File path used to create L</"handle">, can also be automatically generated if
195 197
 necessary.
196 198
 
197 199
 =head2 tmpdir
... ...
@@ -199,7 +201,7 @@ necessary.
199 201
   my $tmpdir = $file->tmpdir;
200 202
   $file      = $file->tmpdir('/tmp');
201 203
 
202
-Temporary directory used to generate C<path>, defaults to the value of the
204
+Temporary directory used to generate L</"path">, defaults to the value of the
203 205
 MOJO_TMPDIR environment variable or auto detection.
204 206
 
205 207
 =head1 METHODS
... ...
@@ -237,7 +239,7 @@ True.
237 239
 
238 240
   $file = $file->move_to('/home/sri/bar.txt');
239 241
 
240
-Move asset data into a specific file and disable C<cleanup>.
242
+Move asset data into a specific file and disable L</"cleanup">.
241 243
 
242 244
 =head2 size
243 245
 
+5 -3
mojo/lib/Mojo/Asset/Memory.pm
... ...
@@ -55,6 +55,8 @@ sub slurp { shift->{content} }
55 55
 
56 56
 1;
57 57
 
58
+=encoding utf8
59
+
58 60
 =head1 NAME
59 61
 
60 62
 Mojo::Asset::Memory - In-memory storage for HTTP content
... ...
@@ -97,10 +99,10 @@ implements the following new ones.
97 99
 
98 100
 =head2 auto_upgrade
99 101
 
100
-  my $upgrade = $mem->auto_upgrade;
101
-  $mem        = $mem->auto_upgrade(1);
102
+  my $bool = $mem->auto_upgrade;
103
+  $mem     = $mem->auto_upgrade($bool);
102 104
 
103
-Try to detect if content size exceeds C<max_memory_size> limit and
105
+Try to detect if content size exceeds L</"max_memory_size"> limit and
104 106
 automatically upgrade to a L<Mojo::Asset::File> object.
105 107
 
106 108
 =head2 max_memory_size
+13 -15
mojo/lib/Mojo/Base.pm
... ...
@@ -14,7 +14,6 @@ use IO::Handle ();
14 14
 sub import {
15 15
   my $class = shift;
16 16
   return unless my $flag = shift;
17
-  no strict 'refs';
18 17
 
19 18
   # Base
20 19
   if ($flag eq '-base') { $flag = $class }
... ...
@@ -23,21 +22,24 @@ sub import {
23 22
   elsif ($flag eq '-strict') { $flag = undef }
24 23
 
25 24
   # Module
26
-  else {
27
-    my $file = $flag;
28
-    $file =~ s/::|'/\//g;
29
-    require "$file.pm" unless $flag->can('new');
25
+  elsif ((my $file = $flag) && !$flag->can('new')) {
26
+    $file =~ s!::|'!/!g;
27
+    require "$file.pm";
30 28
   }
31 29
 
32 30
   # ISA
33 31
   if ($flag) {
34 32
     my $caller = caller;
33
+    no strict 'refs';
35 34
     push @{"${caller}::ISA"}, $flag;
36 35
     *{"${caller}::has"} = sub { attr($caller, @_) };
37 36
   }
38 37
   
39 38
   my $caller = caller;
40
-  *{"${caller}::say"} = sub { say(@_) };
39
+  {
40
+    no strict 'refs';
41
+    *{"${caller}::say"} = sub { say(@_) };
42
+  }
41 43
 
42 44
   # Mojo modules are strict!
43 45
   strict->import;
... ...
@@ -51,9 +53,6 @@ sub new {
51 53
   bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
52 54
 }
53 55
 
54
-# Performance is very important for something as often used as accessors,
55
-# so we optimize them by compiling our own code, don't be scared, we have
56
-# tests for every single case
57 56
 sub attr {
58 57
   my ($class, $attrs, $default) = @_;
59 58
   return unless ($class = ref $class || $class) && $attrs;
... ...
@@ -61,7 +60,6 @@ sub attr {
61 60
   Carp::croak 'Default has to be a code reference or constant value'
62 61
     if ref $default && ref $default ne 'CODE';
63 62
 
64
-  # Compile attributes
65 63
   for my $attr (@{ref $attrs eq 'ARRAY' ? $attrs : [$attrs]}) {
66 64
     Carp::croak qq{Attribute "$attr" invalid} unless $attr =~ /^[a-zA-Z_]\w*$/;
67 65
 
... ...
@@ -89,8 +87,6 @@ sub attr {
89 87
     # Footer (return invocant)
90 88
     $code .= "  \$_[0];\n}";
91 89
 
92
-    # We compile custom attribute code for speed
93
-    no strict 'refs';
94 90
     warn "-- Attribute $attr in $class\n$code\n\n" if $ENV{MOJO_BASE_DEBUG};
95 91
     Carp::croak "Mojo::Base error: $@" unless eval "$code;1";
96 92
   }
... ...
@@ -104,6 +100,8 @@ sub tap {
104 100
 
105 101
 1;
106 102
 
103
+=encoding utf8
104
+
107 105
 =head1 NAME
108 106
 
109 107
 Mojo::Base - Minimal base class for Mojo projects
... ...
@@ -185,7 +183,7 @@ flag or a base class.
185 183
   has [qw(name1 name2 name3)] => 'foo';
186 184
   has [qw(name1 name2 name3)] => sub {...};
187 185
 
188
-Create attributes for hash-based objects, just like the C<attr> method.
186
+Create attributes for hash-based objects, just like the L</"attr"> method.
189 187
 
190 188
 =head1 METHODS
191 189
 
... ...
@@ -222,8 +220,8 @@ argument.
222 220
   $object = $object->tap(sub {...});
223 221
 
224 222
 K combinator, tap into a method chain to perform operations on an object
225
-within the chain. The object will be the first argument passed to the closure
226
-and is also available via C<$_>.
223
+within the chain. The object will be the first argument passed to the callback
224
+and is also available as C<$_>.
227 225
 
228 226
 =head2 C<say>
229 227
 
+22 -6
mojo/lib/Mojo/ByteStream.pm
... ...
@@ -1,5 +1,5 @@
1 1
 package Mojo::ByteStream;
2
-use Mojo::Base -base;
2
+use Mojo::Base -strict;
3 3
 use overload '""' => sub { shift->to_string }, fallback => 1;
4 4
 
5 5
 use Exporter 'import';
... ...
@@ -63,10 +63,14 @@ sub split {
63 63
   return Mojo::Collection->new(map { $self->new($_) } split $pattern, $$self);
64 64
 }
65 65
 
66
+sub tap { shift->Mojo::Base::tap(@_) }
67
+
66 68
 sub to_string { ${$_[0]} }
67 69
 
68 70
 1;
69 71
 
72
+=encoding utf8
73
+
70 74
 =head1 NAME
71 75
 
72 76
 Mojo::ByteStream - ByteStream
... ...
@@ -104,8 +108,7 @@ Construct a new scalar-based L<Mojo::ByteStream> object.
104 108
 
105 109
 =head1 METHODS
106 110
 
107
-L<Mojo::ByteStream> inherits all methods from L<Mojo::Base> and implements the
108
-following new ones.
111
+L<Mojo::ByteStream> implements the following methods.
109 112
 
110 113
 =head2 new
111 114
 
... ...
@@ -219,7 +222,7 @@ Print bytestream to handle and append a newline, defaults to C<STDOUT>.
219 222
 
220 223
 =head2 secure_compare
221 224
 
222
-  my $success = $stream->secure_compare($str);
225
+  my $bool = $stream->secure_compare($str);
223 226
 
224 227
 Compare bytestream with L<Mojo::Util/"secure_compare">.
225 228
 
... ...
@@ -263,9 +266,10 @@ Write all data from bytestream at once to file with L<Mojo::Util/"spurt">.
263 266
 
264 267
   my $collection = $stream->split(',');
265 268
 
266
-Turn bytestream into L<Mojo::Collection>.
269
+Turn bytestream into L<Mojo::Collection> object containing L<Mojo::ByteStream>
270
+objects.
267 271
 
268
-  b('a,b,c')->split(',')->pluck('quote')->join(',')->say;
272
+  b('a,b,c')->split(',')->quote->join(',')->say;
269 273
 
270 274
 =head2 squish
271 275
 
... ...
@@ -275,6 +279,12 @@ Trim whitespace characters from both ends of bytestream and then change all
275 279
 consecutive groups of whitespace into one space each with
276 280
 L<Mojo::Util/"squish">.
277 281
 
282
+=head2 tap
283
+
284
+  $stream = $stream->tap(sub {...});
285
+
286
+Alias for L<Mojo::Base/"tap">.
287
+
278 288
 =head2 to_string
279 289
 
280 290
   my $str = $stream->to_string;
... ...
@@ -327,6 +337,12 @@ bytestream with L<Mojo::Util/"xml_escape">.
327 337
 
328 338
 XOR encode bytestream with L<Mojo::Util/"xor_encode">.
329 339
 
340
+=head1 BYTESTREAM
341
+
342
+Direct scalar reference access to the bytestream is also possible.
343
+
344
+  $$stream .= 'foo';
345
+
330 346
 =head1 SEE ALSO
331 347
 
332 348
 L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+2
mojo/lib/Mojo/Cache.pm
... ...
@@ -19,6 +19,8 @@ sub set {
19 19
 
20 20
 1;
21 21
 
22
+=encoding utf8
23
+
22 24
 =head1 NAME
23 25
 
24 26
 Mojo::Cache - Naive in-memory cache
+76 -23
mojo/lib/Mojo/Collection.pm
... ...
@@ -1,16 +1,29 @@
1 1
 package Mojo::Collection;
2
-use Mojo::Base -base;
3
-use overload
4
-  'bool'   => sub {1},
5
-  '""'     => sub { shift->join("\n") },
6
-  fallback => 1;
2
+use Mojo::Base -strict;
3
+use overload bool => sub {1}, '""' => sub { shift->join("\n") }, fallback => 1;
7 4
 
5
+use Carp 'croak';
8 6
 use Exporter 'import';
9 7
 use List::Util;
10 8
 use Mojo::ByteStream;
9
+use Scalar::Util 'blessed';
11 10
 
12 11
 our @EXPORT_OK = ('c');
13 12
 
13
+sub AUTOLOAD {
14
+  my $self = shift;
15
+
16
+  my ($package, $method) = our $AUTOLOAD =~ /^([\w:]+)::(\w+)$/;
17
+  croak "Undefined subroutine &${package}::$method called"
18
+    unless blessed $self && $self->isa(__PACKAGE__);
19
+
20
+  croak qq{Can't locate object method "$method" via package "$package"}
21
+    unless @$self;
22
+  return $self->pluck($method, @_);
23
+}
24
+
25
+sub DESTROY { }
26
+
14 27
 sub new {
15 28
   my $class = shift;
16 29
   return bless [@_], ref $class || $class;
... ...
@@ -18,6 +31,10 @@ sub new {
18 31
 
19 32
 sub c { __PACKAGE__->new(@_) }
20 33
 
34
+sub compact {
35
+  shift->grep(sub { length(defined $_ ? $_ : '') });
36
+}
37
+
21 38
 sub each {
22 39
   my ($self, $cb) = @_;
23 40
   return @$self unless $cb;
... ...
@@ -33,16 +50,15 @@ sub first {
33 50
   return List::Util::first { $_ =~ $cb } @$self;
34 51
 }
35 52
 
53
+sub flatten { $_[0]->new(_flatten(@{$_[0]})) }
54
+
36 55
 sub grep {
37 56
   my ($self, $cb) = @_;
38 57
   return $self->new(grep { $cb->($_) } @$self) if ref $cb eq 'CODE';
39 58
   return $self->new(grep { $_ =~ $cb } @$self);
40 59
 }
41 60
 
42
-sub join {
43
-  my ($self, $expr) = @_;
44
-  return Mojo::ByteStream->new(join $expr, map({"$_"} @$self));
45
-}
61
+sub join { Mojo::ByteStream->new(join $_[1], map({"$_"} @{$_[0]})) }
46 62
 
47 63
 sub map {
48 64
   my ($self, $cb) = @_;
... ...
@@ -54,15 +70,9 @@ sub pluck {
54 70
   return $self->map(sub { $_->$method(@args) });
55 71
 }
56 72
 
57
-sub reverse {
58
-  my $self = shift;
59
-  return $self->new(reverse @$self);
60
-}
73
+sub reverse { $_[0]->new(reverse @{$_[0]}) }
61 74
 
62
-sub shuffle {
63
-  my $self = shift;
64
-  return $self->new(List::Util::shuffle @$self);
65
-}
75
+sub shuffle { $_[0]->new(List::Util::shuffle @{$_[0]}) }
66 76
 
67 77
 sub size { scalar @{$_[0]} }
68 78
 
... ...
@@ -76,14 +86,24 @@ sub sort {
76 86
   return $self->new($cb ? sort { $a->$cb($b) } @$self : sort @$self);
77 87
 }
78 88
 
89
+sub tap { shift->Mojo::Base::tap(@_) }
90
+
79 91
 sub uniq {
80 92
   my $self = shift;
81 93
   my %seen;
82 94
   return $self->grep(sub { !$seen{$_}++ });
83 95
 }
84 96
 
97
+sub _flatten {
98
+  map { _ref($_) ? _flatten(@$_) : $_ } @_;
99
+}
100
+
101
+sub _ref { ref $_[0] && (ref $_[0] eq 'ARRAY' || $_[0]->isa(__PACKAGE__)) }
102
+
85 103
 1;
86 104
 
105
+=encoding utf8
106
+
87 107
 =head1 NAME
88 108
 
89 109
 Mojo::Collection - Collection
... ...
@@ -119,8 +139,7 @@ Construct a new array-based L<Mojo::Collection> object.
119 139
 
120 140
 =head1 METHODS
121 141
 
122
-L<Mojo::Collection> inherits all methods from L<Mojo::Base> and implements the
123
-following new ones.
142
+L<Mojo::Collection> implements the following methods.
124 143
 
125 144
 =head2 new
126 145
 
... ...
@@ -128,12 +147,21 @@ following new ones.
128 147
 
129 148
 Construct a new array-based L<Mojo::Collection> object.
130 149
 
150
+=head2 compact
151
+
152
+  my $new = $collection->compact;
153
+
154
+Create a new collection with all elements that are defined and not an empty
155
+string.
156
+
131 157
 =head2 each
132 158
 
133 159
   my @elements = $collection->each;
134 160
   $collection  = $collection->each(sub {...});
135 161
 
136
-Evaluate callback for each element in collection.
162
+Evaluate callback for each element in collection or return all elements as a
163
+list if none has been provided. The element will be the first argument passed
164
+to the callback and is also available as C<$_>.
137 165
 
138 166
   $collection->each(sub {
139 167
     my ($e, $count) = @_;
... ...
@@ -148,10 +176,18 @@ Evaluate callback for each element in collection.
148 176
 
149 177
 Evaluate regular expression or callback for each element in collection and
150 178
 return the first one that matched the regular expression, or for which the
151
-callback returned true.
179
+callback returned true. The element will be the first argument passed to the
180
+callback and is also available as C<$_>.
152 181
 
153 182
   my $five = $collection->first(sub { $_ == 5 });
154 183
 
184
+=head2 flatten
185
+
186
+  my $new = $collection->flatten;
187
+
188
+Flatten nested collections/arrays recursively and create a new collection with
189
+all elements.
190
+
155 191
 =head2 grep
156 192
 
157 193
   my $new = $collection->grep(qr/foo/);
... ...
@@ -159,7 +195,8 @@ callback returned true.
159 195
 
160 196
 Evaluate regular expression or callback for each element in collection and
161 197
 create a new collection with all elements that matched the regular expression,
162
-or for which the callback returned true.
198
+or for which the callback returned true. The element will be the first
199
+argument passed to the callback and is also available as C<$_>.
163 200
 
164 201
   my $interesting = $collection->grep(qr/mojo/i);
165 202
 
... ...
@@ -176,7 +213,8 @@ Turn collection into L<Mojo::ByteStream>.
176 213
   my $new = $collection->map(sub {...});
177 214
 
178 215
 Evaluate callback for each element in collection and create a new collection
179
-from the results.
216
+from the results. The element will be the first argument passed to the
217
+callback and is also available as C<$_>.
180 218
 
181 219
   my $doubled = $collection->map(sub { $_ * 2 });
182 220
 
... ...
@@ -225,12 +263,27 @@ from the results.
225 263
 
226 264
   my $insensitive = $collection->sort(sub { uc(shift) cmp uc(shift) });
227 265
 
266
+=head2 tap
267
+
268
+  $collection = $collection->tap(sub {...});
269
+
270
+Alias for L<Mojo::Base/"tap">.
271
+
228 272
 =head2 uniq
229 273
 
230 274
   my $new = $collection->uniq;
231 275
 
232 276
 Create a new collection without duplicate elements.
233 277
 
278
+=head1 ELEMENT METHODS
279
+
280
+In addition to the methods above, you can also call methods provided by all
281
+elements in the collection directly and create a new collection from the
282
+results, similar to L</"pluck">.
283
+
284
+  push @$collection, Mojo::DOM->new("<div><h1>$_</h1></div>") for 1 .. 9;
285
+  say $collection->at('h1')->type('h2')->prepend_content('Test ')->root;
286
+
234 287
 =head1 ELEMENTS
235 288
 
236 289
 Direct array reference access to elements is also possible.
+22 -20
mojo/lib/Mojo/Content.pm
... ...
@@ -18,7 +18,7 @@ sub body_size { croak 'Method "body_size" not implemented by subclass' }
18 18
 
19 19
 sub boundary {
20 20
   return undef unless my $type = shift->headers->content_type;
21
-  $type =~ m!multipart.*boundary=(?:"([^"]+)"|([\w'(),.:?\-+/]+))!i
21
+  $type =~ m!multipart.*boundary\s*=\s*(?:"([^"]+)"|([\w'(),.:?\-+/]+))!i
22 22
     and return defined $1 ? $1 : $2;
23 23
   return undef;
24 24
 }
... ...
@@ -27,8 +27,8 @@ sub build_body    { shift->_build('get_body_chunk') }
27 27
 sub build_headers { shift->_build('get_header_chunk') }
28 28
 
29 29
 sub charset {
30
-  my $type = do {my $tmp = shift->headers->content_type; defined $tmp ? $tmp : ''};
31
-  return $type =~ /charset="?([^"\s;]+)"?/i ? $1 : undef;
30
+  my $type = do { my $type = shift->headers->content_type; defined $type ? $type : ''};
31
+  return $type =~ /charset\s*=\s*"?([^"\s;]+)"?/i ? $1 : undef;
32 32
 }
33 33
 
34 34
 sub clone {
... ...
@@ -220,7 +220,7 @@ sub _parse_chunked {
220 220
     # Start new chunk (ignore the chunk extension)
221 221
     unless ($self->{chunk_len}) {
222 222
       last
223
-        unless $self->{pre_buffer} =~ s/^(?:\x0d?\x0a)?([[:xdigit:]]+).*\x0a//;
223
+        unless $self->{pre_buffer} =~ s/^(?:\x0d?\x0a)?([0-9a-fA-F]+).*\x0a//;
224 224
       next if $self->{chunk_len} = hex $1;
225 225
 
226 226
       # Last chunk
... ...
@@ -306,6 +306,8 @@ sub _uncompress {
306 306
 
307 307
 1;
308 308
 
309
+=encoding utf8
310
+
309 311
 =head1 NAME
310 312
 
311 313
 Mojo::Content - HTTP content base class
... ...
@@ -378,8 +380,8 @@ L<Mojo::Content> implements the following attributes.
378 380
 
379 381
 =head2 auto_relax
380 382
 
381
-  my $relax = $content->auto_relax;
382
-  $content  = $content->auto_relax(1);
383
+  my $bool = $content->auto_relax;
384
+  $content = $content->auto_relax($bool);
383 385
 
384 386
 Try to detect when relaxed parsing is necessary.
385 387
 
... ...
@@ -408,16 +410,16 @@ value of the MOJO_MAX_LEFTOVER_SIZE environment variable or C<262144>.
408 410
 
409 411
 =head2 relaxed
410 412
 
411
-  my $relaxed = $content->relaxed;
412
-  $content    = $content->relaxed(1);
413
+  my $bool = $content->relaxed;
414
+  $content = $content->relaxed($bool);
413 415
 
414 416
 Activate relaxed parsing for responses that are terminated with a connection
415 417
 close.
416 418
 
417 419
 =head2 skip_body
418 420
 
419
-  my $skip = $content->skip_body;
420
-  $content = $content->skip_body(1);
421
+  my $bool = $content->skip_body;
422
+  $content = $content->skip_body($bool);
421 423
 
422 424
 Skip body parsing and finish after headers.
423 425
 
... ...
@@ -428,7 +430,7 @@ implements the following new ones.
428 430
 
429 431
 =head2 body_contains
430 432
 
431
-  my $success = $content->body_contains('foo bar baz');
433
+  my $bool = $content->body_contains('foo bar baz');
432 434
 
433 435
 Check if content contains a specific string. Meant to be overloaded in a
434 436
 subclass.
... ...
@@ -496,34 +498,34 @@ Size of headers in bytes.
496 498
 
497 499
 =head2 is_chunked
498 500
 
499
-  my $success = $content->is_chunked;
501
+  my $bool = $content->is_chunked;
500 502
 
501 503
 Check if content is chunked.
502 504
 
503 505
 =head2 is_compressed
504 506
 
505
-  my $success = $content->is_compressed;
507
+  my $bool = $content->is_compressed;
506 508
 
507 509
 Check if content is C<gzip> compressed.
508 510
 
509 511
 =head2 is_dynamic
510 512
 
511
-  my $success = $content->is_dynamic;
513
+  my $bool = $content->is_dynamic;
512 514
 
513
-Check if content will be dynamically generated, which prevents C<clone> from
514
-working.
515
+Check if content will be dynamically generated, which prevents L</"clone">
516
+from working.
515 517
 
516 518
 =head2 is_finished
517 519
 
518
-  my $success = $content->is_finished;
520
+  my $bool = $content->is_finished;
519 521
 
520 522
 Check if parser is finished.
521 523
 
522 524
 =head2 is_limit_exceeded
523 525
 
524
-  my $success = $content->is_limit_exceeded;
526
+  my $bool = $content->is_limit_exceeded;
525 527
 
526
-Check if buffer has exceeded C<max_buffer_size>.
528
+Check if buffer has exceeded L</"max_buffer_size">.
527 529
 
528 530
 =head2 is_multipart
529 531
 
... ...
@@ -533,7 +535,7 @@ False.
533 535
 
534 536
 =head2 is_parsing_body
535 537
 
536
-  my $success = $content->is_parsing_body;
538
+  my $bool = $content->is_parsing_body;
537 539
 
538 540
 Check if body parsing started yet.
539 541
 
+5 -3
mojo/lib/Mojo/Content/MultiPart.pm
... ...
@@ -45,7 +45,7 @@ sub build_boundary {
45 45
   my $boundary;
46 46
   my $size = 1;
47 47
   while (1) {
48
-    $boundary = b64_encode join('', map chr(rand(256)), 1 .. $size++ * 3);
48
+    $boundary = b64_encode join('', map chr(rand 256), 1 .. $size++ * 3);
49 49
     $boundary =~ s/\W/X/g;
50 50
     last unless $self->body_contains($boundary);
51 51
   }
... ...
@@ -199,6 +199,8 @@ sub _read {
199 199
 
200 200
 1;
201 201
 
202
+=encoding utf8
203
+
202 204
 =head1 NAME
203 205
 
204 206
 Mojo::Content::MultiPart - HTTP multipart content
... ...
@@ -258,12 +260,12 @@ implements the following new ones.
258 260
 
259 261
   my $multi = Mojo::Content::MultiPart->new;
260 262
 
261
-Construct a new L<Mojo::Content::MultiPart> object and subscribe to C<read>
263
+Construct a new L<Mojo::Content::MultiPart> object and subscribe to L</"read">
262 264
 event with default content parser.
263 265
 
264 266
 =head2 body_contains
265 267
 
266
-  my $success = $multi->body_contains('foobarbaz');
268
+  my $bool = $multi->body_contains('foobarbaz');
267 269
 
268 270
 Check if content parts contain a specific string.
269 271
 
+6 -4
mojo/lib/Mojo/Content/Single.pm
... ...
@@ -46,13 +46,15 @@ sub parse {
46 46
 
47 47
   # Content needs to be upgraded to multipart
48 48
   $self->unsubscribe(read => $self->{read});
49
-  my $multi = Mojo::Content::MultiPart->new($self);
49
+  my $multi = Mojo::Content::MultiPart->new(%$self);
50 50
   $self->emit(upgrade => $multi);
51 51
   return $multi->parse;
52 52
 }
53 53
 
54 54
 1;
55 55
 
56
+=encoding utf8
57
+
56 58
 =head1 NAME
57 59
 
58 60
 Mojo::Content::Single - HTTP content
... ...
@@ -120,12 +122,12 @@ implements the following new ones.
120 122
 
121 123
   my $single = Mojo::Content::Single->new;
122 124
 
123
-Construct a new L<Mojo::Content::Single> object and subscribe to C<read> event
124
-with default content parser.
125
+Construct a new L<Mojo::Content::Single> object and subscribe to L</"read">
126
+event with default content parser.
125 127
 
126 128
 =head2 body_contains
127 129
 
128
-  my $success = $single->body_contains('1234567');
130
+  my $bool = $single->body_contains('1234567');
129 131
 
130 132
 Check if content contains a specific string.
131 133
 
+3 -32
mojo/lib/Mojo/Cookie.pm
... ...
@@ -1,47 +1,18 @@
1 1
 package Mojo::Cookie;
2 2
 use Mojo::Base -base;
3
-use overload
4
-  'bool'   => sub {1},
5
-  '""'     => sub { shift->to_string },
6
-  fallback => 1;
3
+use overload bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1;
7 4
 
8 5
 use Carp 'croak';
9
-use Mojo::Util 'unquote';
10 6
 
11 7
 has [qw(name value)];
12 8
 
13 9
 sub parse     { croak 'Method "parse" not implemented by subclass' }
14 10
 sub to_string { croak 'Method "to_string" not implemented by subclass' }
15 11
 
16
-sub _tokenize {
17
-  my ($self, $str) = @_;
18
-
19
-  # Nibbling parser
20
-  my (@tree, @token);
21
-  while ($str =~ s/^\s*([^=;,]+)\s*=?\s*//) {
22
-    my $name = $1;
23
-
24
-    # "expires" is a special case, thank you Netscape...
25
-    $str =~ s/^([^;,]+,?[^;,]+)/"$1"/ if $name =~ /^expires$/i;
26
-
27
-    # Value
28
-    my $value;
29
-    $value = unquote $1 if $str =~ s/^("(?:\\\\|\\"|[^"])+"|[^;,]+)\s*//;
30
-    push @token, [$name, $value];
31
-
32
-    # Separator
33
-    $str =~ s/^\s*;\s*//;
34
-    next unless $str =~ s/^\s*,\s*//;
35
-    push @tree, [@token];
36
-    @token = ();
37
-  }
38
-
39
-  # Take care of final token
40
-  return @token ? (@tree, \@token) : @tree;
41
-}
42
-
43 12
 1;
44 13
 
14
+=encoding utf8
15
+
45 16
 =head1 NAME
46 17
 
47 18
 Mojo::Cookie - HTTP cookie base class
+8 -6
mojo/lib/Mojo/Cookie/Request.pm
... ...
@@ -1,14 +1,15 @@
1 1
 package Mojo::Cookie::Request;
2 2
 use Mojo::Base 'Mojo::Cookie';
3 3
 
4
-use Mojo::Util 'quote';
4
+use Mojo::Util qw(quote split_header);
5 5
 
6 6
 sub parse {
7 7
   my ($self, $str) = @_;
8 8
 
9 9
   my @cookies;
10
-  for my $token (map {@$_} $self->_tokenize(defined $str ? $str : '')) {
11
-    my ($name, $value) = @$token;
10
+  my @pairs = map {@$_} @{split_header(defined $str? $str: '')};
11
+  while (@pairs) {
12
+    my ($name, $value) = (shift @pairs, shift @pairs);
12 13
     next if $name =~ /^\$/;
13 14
     push @cookies, $self->new(name => $name, value => defined $value ? $value : '');
14 15
   }
... ...
@@ -18,14 +19,15 @@ sub parse {
18 19
 
19 20
 sub to_string {
20 21
   my $self = shift;
21
-  return '' unless my $name = $self->name;
22
+  return '' unless length(my $name = defined $self->name ? $self->name : '');
22 23
   my $value = defined $self->value ? $self->value : '';
23
-  $value = $value =~ /[,;"]/ ? quote($value) : $value;
24
-  return "$name=$value";
24
+  return join '=', $name, $value =~ /[,;" ]/ ? quote($value) : $value;
25 25
 }
26 26
 
27 27
 1;
28 28
 
29
+=encoding utf8
30
+
29 31
 =head1 NAME
30 32
 
31 33
 Mojo::Cookie::Request - HTTP request cookie
+38 -22
mojo/lib/Mojo/Cookie/Response.pm
... ...
@@ -2,9 +2,9 @@ package Mojo::Cookie::Response;
2 2
 use Mojo::Base 'Mojo::Cookie';
3 3
 
4 4
 use Mojo::Date;
5
-use Mojo::Util 'quote';
5
+use Mojo::Util qw(quote split_header);
6 6
 
7
-has [qw(domain httponly max_age path secure)];
7
+has [qw(domain httponly max_age origin path secure)];
8 8
 
9 9
 sub expires {
10 10
   my $self = shift;
... ...
@@ -22,21 +22,29 @@ sub parse {
22 22
   my ($self, $str) = @_;
23 23
 
24 24
   my @cookies;
25
-  for my $token ($self->_tokenize(defined $str ? $str : '')) {
26
-    for my $i (0 .. $#$token) {
27
-      my ($name, $value) = @{$token->[$i]};
25
+  my $tree = split_header(defined $str ? $str : '');
26
+  while (my $pairs = shift @$tree) {
27
+    my $i = 0;
28
+    while (@$pairs) {
29
+      my ($name, $value) = (shift @$pairs, shift @$pairs);
30
+
31
+      # "expires" is a special case, thank you Netscape...
32
+      if ($name =~ /^expires$/i) {
33
+        push @$pairs, @{my $elem = shift @$tree; defined $elem ? $elem : []};
34
+        my $len = (defined $pairs->[0] ? $pairs->[0] : '') =~ /-/ ? 6 : 10;
35
+        $value .= join ' ', ',', grep {defined} splice @$pairs, 0, $len;
36
+      }
28 37
 
29 38
       # This will only run once
30 39
       push @cookies, $self->new(name => $name, value => defined $value ? $value : '') and next
31
-        unless $i;
40
+        unless $i++;
32 41
 
33 42
       # Attributes (Netscape and RFC 6265)
34
-      my @match
35
-        = $name =~ /^(expires|domain|path|secure|Max-Age|HttpOnly)$/msi;
36
-      next unless @match;
37
-      my $attr = lc $match[0];
38
-      $attr =~ tr/-/_/;
39
-      $cookies[-1]->$attr($attr =~ /(?:secure|HttpOnly)/i ? 1 : $value);
43
+      next unless $name =~ /^(expires|domain|path|secure|max-age|httponly)$/i;
44
+      my $attr = lc $1;
45
+      $attr = 'max_age' if $attr eq 'max-age';
46
+      $cookies[-1]
47
+        ->$attr($attr eq 'secure' || $attr eq 'httponly' ? 1 : $value);
40 48
     }
41 49
   }
42 50
 
... ...
@@ -47,10 +55,9 @@ sub to_string {
47 55
   my $self = shift;
48 56
 
49 57
   # Name and value (Netscape)
50
-  return '' unless my $name = $self->name;
58
+  return '' unless length(my $name = defined $self->name ? $self->name : '');
51 59
   my $value = defined $self->value ? $self->value : '';
52
-  $value = $value =~ /[,;"]/ ? quote($value) : $value;
53
-  my $cookie = "$name=$value";
60
+  my $cookie = join '=', $name, $value =~ /[,;" ]/ ? quote($value) : $value;
54 61
 
55 62
   # "expires" (Netscape)
56 63
   if (defined(my $e = $self->expires)) { $cookie .= "; expires=$e" }
... ...
@@ -62,19 +69,21 @@ sub to_string {
62 69
   if (my $path = $self->path) { $cookie .= "; path=$path" }
63 70
 
64 71
   # "secure" (Netscape)
65
-  if (my $secure = $self->secure) { $cookie .= "; secure" }
72
+  $cookie .= "; secure" if $self->secure;
66 73
 
67 74
   # "Max-Age" (RFC 6265)
68
-  if (defined(my $m = $self->max_age)) { $cookie .= "; Max-Age=$m" }
75
+  if (defined(my $max = $self->max_age)) { $cookie .= "; Max-Age=$max" }
69 76
 
70 77
   # "HttpOnly" (RFC 6265)
71
-  if (my $httponly = $self->httponly) { $cookie .= "; HttpOnly" }
78
+  $cookie .= "; HttpOnly" if $self->httponly;
72 79
 
73 80
   return $cookie;
74 81
 }
75 82
 
76 83
 1;
77 84
 
85
+=encoding utf8
86
+
78 87
 =head1 NAME
79 88
 
80 89
 Mojo::Cookie::Response - HTTP response cookie
... ...
@@ -107,8 +116,8 @@ Cookie domain.
107 116
 
108 117
 =head2 httponly
109 118
 
110
-  my $httponly = $cookie->httponly;
111
-  $cookie      = $cookie->httponly(1);
119
+  my $bool = $cookie->httponly;
120
+  $cookie  = $cookie->httponly($bool);
112 121
 
113 122
 HttpOnly flag, which can prevent client-side scripts from accessing this
114 123
 cookie.
... ...
@@ -120,6 +129,13 @@ cookie.
120 129
 
121 130
 Max age for cookie.
122 131
 
132
+=head2 origin
133
+
134
+  my $origin = $cookie->origin;
135
+  $cookie    = $cookie->origin('mojolicio.us');
136
+
137
+Origin of the cookie.
138
+
123 139
 =head2 path
124 140
 
125 141
   my $path = $cookie->path;
... ...
@@ -129,8 +145,8 @@ Cookie path.
129 145
 
130 146
 =head2 secure
131 147
 
132
-  my $secure = $cookie->secure;
133
-  $cookie    = $cookie->secure(1);
148
+  my $bool = $cookie->secure;
149
+  $cookie  = $cookie->secure($bool);
134 150
 
135 151
 Secure flag, which instructs browsers to only send this cookie over HTTPS
136 152
 connections.
+229 -158
mojo/lib/Mojo/DOM.pm
... ...
@@ -1,8 +1,8 @@
1 1
 package Mojo::DOM;
2
-use Mojo::Base -base;
2
+use Mojo::Base -strict;
3 3
 use overload
4
-  '%{}'    => sub { shift->attrs },
5
-  'bool'   => sub {1},
4
+  '%{}'    => sub { shift->attr },
5
+  bool     => sub {1},
6 6
   '""'     => sub { shift->to_xml },
7 7
   fallback => 1;
8 8
 
... ...
@@ -36,23 +36,22 @@ sub new {
36 36
   return @_ ? $self->parse(@_) : $self;
37 37
 }
38 38
 
39
-sub all_text {
40
-  my $tree = shift->tree;
41
-  return _text(_elements($tree), 1, _trim($tree, @_));
42
-}
39
+sub all_text { shift->_content(1, @_) }
40
+
41
+sub ancestors { _select($_[0]->_collect(_ancestors($_[0]->tree)), $_[1]) }
43 42
 
44 43
 sub append { shift->_add(1, @_) }
45 44
 
46 45
 sub append_content {
47 46
   my ($self, $new) = @_;
48 47
   my $tree = $self->tree;
49
-  push @$tree, @{_parent($self->_parse("$new"), $tree)};
48
+  push @$tree, _link($self->_parse("$new"), $tree);
50 49
   return $self;
51 50
 }
52 51
 
53 52
 sub at { shift->find(@_)->[0] }
54 53
 
55
-sub attrs {
54
+sub attr {
56 55
   my $self = shift;
57 56
 
58 57
   # Hash
... ...
@@ -70,45 +69,35 @@ sub attrs {
70 69
 }
71 70
 
72 71
 sub children {
73
-  my ($self, $type) = @_;
74
-
75
-  my @children;
76
-  my $xml  = $self->xml;
77
-  my $tree = $self->tree;
78
-  for my $e (@$tree[($tree->[0] eq 'root' ? 1 : 4) .. $#$tree]) {
79
-
80
-    # Make sure child is the right type
81
-    next if $e->[0] ne 'tag' || (defined $type && $e->[1] ne $type);
82
-    push @children, $self->new->tree($e)->xml($xml);
83
-  }
84
-
85
-  return Mojo::Collection->new(@children);
72
+  my $self = shift;
73
+  return _select(
74
+    $self->_collect(grep { $_->[0] eq 'tag' } _nodes($self->tree)), @_);
86 75
 }
87 76
 
88 77
 sub content_xml {
89 78
   my $self = shift;
90
-
91
-  # Render children individually
92
-  my $tree = $self->tree;
93 79
   my $xml  = $self->xml;
94
-  return join '',
95
-    map { Mojo::DOM::HTML->new(tree => $_, xml => $xml)->render }
96
-    @$tree[($tree->[0] eq 'root' ? 1 : 4) .. $#$tree];
80
+  return join '', map { _render($_, $xml) } _nodes($self->tree);
97 81
 }
98 82
 
99 83
 sub find {
100
-  my ($self, $selector) = @_;
101
-  my $xml = $self->xml;
102
-  my $results = Mojo::DOM::CSS->new(tree => $self->tree)->select($selector);
103
-  return Mojo::Collection->new(map { $self->new->tree($_)->xml($xml) }
104
-      @$results);
84
+  my $self = shift;
85
+  my $results = Mojo::DOM::CSS->new(tree => $self->tree)->select(@_);
86
+  return $self->_collect(@$results);
87
+}
88
+
89
+sub match {
90
+  my $self = shift;
91
+  return undef unless Mojo::DOM::CSS->new(tree => $self->tree)->match(@_);
92
+  return $self;
105 93
 }
106 94
 
107 95
 sub namespace {
108 96
   my $self = shift;
109 97
 
110
-  # Extract namespace prefix and search parents
111 98
   return '' if (my $current = $self->tree)->[0] eq 'root';
99
+
100
+  # Extract namespace prefix and search parents
112 101
   my $ns = $current->[1] =~ /^(.*?):/ ? "xmlns:$1" : undef;
113 102
   while ($current->[0] ne 'root') {
114 103
 
... ...
@@ -119,14 +108,13 @@ sub namespace {
119 108
     # Namespace attribute
120 109
     elsif (defined $attrs->{xmlns}) { return $attrs->{xmlns} }
121 110
 
122
-    # Parent
123 111
     $current = $current->[3];
124 112
   }
125 113
 
126 114
   return '';
127 115
 }
128 116
 
129
-sub next { shift->_sibling(1) }
117
+sub next { shift->_siblings->[1][0] }
130 118
 
131 119
 sub parent {
132 120
   my $self = shift;
... ...
@@ -134,201 +122,228 @@ sub parent {
134 122
   return $self->new->tree($tree->[3])->xml($self->xml);
135 123
 }
136 124
 
137
-sub parse { shift->_html(parse => shift) }
125
+sub parse { shift->_delegate(parse => shift) }
138 126
 
139 127
 sub prepend { shift->_add(0, @_) }
140 128
 
141 129
 sub prepend_content {
142 130
   my ($self, $new) = @_;
143 131
   my $tree = $self->tree;
144
-  splice @$tree, $tree->[0] eq 'root' ? 1 : 4, 0,
145
-    @{_parent($self->_parse("$new"), $tree)};
132
+  splice @$tree, _offset($tree), 0, _link($self->_parse("$new"), $tree);
146 133
   return $self;
147 134
 }
148 135
 
149
-sub previous { shift->_sibling(0) }
136
+sub previous { shift->_siblings->[0][-1] }
150 137
 
151 138
 sub remove { shift->replace('') }
152 139
 
153 140
 sub replace {
154 141
   my ($self, $new) = @_;
155
-
156 142
   my $tree = $self->tree;
157
-  if   ($tree->[0] eq 'root') { return $self->xml(undef)->parse($new) }
158
-  else                        { $new = $self->_parse("$new") }
159
-
160
-  my $parent = $tree->[3];
161
-  my $i = $parent->[0] eq 'root' ? 1 : 4;
162
-  for my $e (@$parent[$i .. $#$parent]) {
163
-    last if $e == $tree;
164
-    $i++;
165
-  }
166
-  splice @$parent, $i, 1, @{_parent($new, $parent)};
167
-
168
-  return $self;
143
+  return $self->xml(undef)->parse($new) if $tree->[0] eq 'root';
144
+  return $self->_replace($tree, $self->_parse("$new"));
169 145
 }
170 146
 
171 147
 sub replace_content {
172 148
   my ($self, $new) = @_;
173 149
   my $tree = $self->tree;
174
-  splice @$tree, $tree->[0] eq 'root' ? 1 : 4, $#$tree,
175
-    @{_parent($self->_parse("$new"), $tree)};
150
+  splice @$tree, _offset($tree), $#$tree, _link($self->_parse("$new"), $tree);
176 151
   return $self;
177 152
 }
178 153
 
179 154
 sub root {
180 155
   my $self = shift;
156
+  return $self unless my $tree = _ancestors($self->tree, 1);
157
+  return $self->new->tree($tree)->xml($self->xml);
158
+}
181 159
 
182
-  my $root = $self->tree;
183
-  while ($root->[0] eq 'tag') {
184
-    last unless my $parent = $root->[3];
185
-    $root = $parent;
186
-  }
160
+sub siblings { _select(Mojo::Collection->new(@{_siblings($_[0], 1)}), $_[1]) }
187 161
 
188
-  return $self->new->tree($root)->xml($self->xml);
162
+sub strip {
163
+  my $self = shift;
164
+  my $tree = $self->tree;
165
+  return $self if $tree->[0] eq 'root';
166
+  return $self->_replace($tree, ['root', _nodes($tree)]);
189 167
 }
190 168
 
191
-sub text {
192
-  my $tree = shift->tree;
193
-  return _text(_elements($tree), 0, _trim($tree, @_));
194
-}
169
+sub tap { shift->Mojo::Base::tap(@_) }
170
+
171
+sub text { shift->_content(0, @_) }
195 172
 
196 173
 sub text_after {
197 174
   my ($self, $trim) = @_;
198 175
 
199
-  # Find following text elements
200 176
   return '' if (my $tree = $self->tree)->[0] eq 'root';
201
-  my (@elements, $started);
202
-  for my $e (@{_elements($tree->[3])}) {
203
-    ++$started and next if $e eq $tree;
177
+
178
+  my (@nodes, $started);
179
+  for my $n (_nodes($tree->[3])) {
180
+    ++$started and next if $n eq $tree;
204 181
     next unless $started;
205
-    last if $e->[0] eq 'tag';
206
-    push @elements, $e;
182
+    last if $n->[0] eq 'tag';
183
+    push @nodes, $n;
207 184
   }
208 185
 
209
-  return _text(\@elements, 0, _trim($tree->[3], $trim));
186
+  return _text(\@nodes, 0, _trim($tree->[3], $trim));
210 187
 }
211 188
 
212 189
 sub text_before {
213 190
   my ($self, $trim) = @_;
214 191
 
215
-  # Find preceding text elements
216 192
   return '' if (my $tree = $self->tree)->[0] eq 'root';
217
-  my @elements;
218
-  for my $e (@{_elements($tree->[3])}) {
219
-    last if $e eq $tree;
220
-    push @elements, $e;
221
-    @elements = () if $e->[0] eq 'tag';
193
+
194
+  my @nodes;
195
+  for my $n (_nodes($tree->[3])) {
196
+    last if $n eq $tree;
197
+    push @nodes, $n;
198
+    @nodes = () if $n->[0] eq 'tag';
222 199
   }
223 200
 
224
-  return _text(\@elements, 0, _trim($tree->[3], $trim));
201
+  return _text(\@nodes, 0, _trim($tree->[3], $trim));
225 202
 }
226 203
 
227 204
 sub to_xml { shift->[0]->render }
228 205
 
229
-sub tree { shift->_html(tree => @_) }
206
+sub tree { shift->_delegate(tree => @_) }
230 207
 
231 208
 sub type {
232 209
   my ($self, $type) = @_;
233
-
234
-  # Get
235 210
   return '' if (my $tree = $self->tree)->[0] eq 'root';
236 211
   return $tree->[1] unless $type;
237
-
238
-  # Set
239 212
   $tree->[1] = $type;
240
-
241 213
   return $self;
242 214
 }
243 215
 
244
-sub xml { shift->_html(xml => @_) }
216
+sub xml { shift->_delegate(xml => @_) }
245 217
 
246 218
 sub _add {
247 219
   my ($self, $offset, $new) = @_;
248 220
 
249
-  # Not a tag
250 221
   return $self if (my $tree = $self->tree)->[0] eq 'root';
251 222
 
252
-  # Find parent
253 223
   my $parent = $tree->[3];
254
-  my $i = $parent->[0] eq 'root' ? 1 : 4;
255
-  for my $e (@$parent[$i .. $#$parent]) {
256
-    last if $e == $tree;
257
-    $i++;
258
-  }
259
-
260
-  # Add children
261
-  splice @$parent, $i + $offset, 0, @{_parent($self->_parse("$new"), $parent)};
224
+  splice @$parent, _parent($parent, $tree) + $offset, 0,
225
+    _link($self->_parse("$new"), $parent);
262 226
 
263 227
   return $self;
264 228
 }
265 229
 
266
-sub _elements {
267
-  return [] unless my $e = shift;
268
-  return [@$e[($e->[0] eq 'root' ? 1 : 4) .. $#$e]];
230
+sub _ancestors {
231
+  my ($tree, $root) = @_;
232
+  my @ancestors;
233
+  push @ancestors, $tree while ($tree->[0] eq 'tag') && ($tree = $tree->[3]);
234
+  return $root ? $ancestors[-1] : @ancestors[0 .. $#ancestors - 1];
235
+}
236
+
237
+sub _collect {
238
+  my $self = shift;
239
+  my $xml  = $self->xml;
240
+  return Mojo::Collection->new(@_)
241
+    ->map(sub { $self->new->tree($_)->xml($xml) });
242
+}
243
+
244
+sub _content {
245
+  my $tree = shift->tree;
246
+  return _text([_nodes($tree)], shift, _trim($tree, @_));
269 247
 }
270 248
 
271
-sub _html {
249
+sub _delegate {
272 250
   my ($self, $method) = (shift, shift);
273 251
   return $self->[0]->$method unless @_;
274 252
   $self->[0]->$method(@_);
275 253
   return $self;
276 254
 }
277 255
 
278
-sub _parent {
256
+sub _link {
279 257
   my ($children, $parent) = @_;
280 258
 
281 259
   # Link parent to children
282 260
   my @new;
283
-  for my $e (@$children[1 .. $#$children]) {
284
-    if ($e->[0] eq 'tag') {
285
-      $e->[3] = $parent;
286
-      weaken $e->[3];
287
-    }
288
-    push @new, $e;
261
+  for my $n (@$children[1 .. $#$children]) {
262
+    push @new, $n;
263
+    next unless $n->[0] eq 'tag';
264
+    $n->[3] = $parent;
265
+    weaken $n->[3];
266
+  }
267
+
268
+  return @new;
269
+}
270
+
271
+sub _nodes {
272
+  return unless my $n = shift;
273
+  return @$n[_offset($n) .. $#$n];
274
+}
275
+
276
+sub _offset { $_[0][0] eq 'root' ? 1 : 4 }
277
+
278
+sub _parent {
279
+  my ($parent, $child) = @_;
280
+
281
+  # Find parent offset for child
282
+  my $i = _offset($parent);
283
+  for my $n (@$parent[$i .. $#$parent]) {
284
+    last if $n == $child;
285
+    $i++;
289 286
   }
290 287
 
291
-  return \@new;
288
+  return $i;
292 289
 }
293 290
 
294 291
 sub _parse { Mojo::DOM::HTML->new(xml => shift->xml)->parse(shift)->tree }
295 292
 
296
-sub _sibling {
297
-  my ($self, $next) = @_;
293
+sub _render { Mojo::DOM::HTML->new(tree => shift, xml => shift)->render }
294
+
295
+sub _replace {
296
+  my ($self, $tree, $new) = @_;
297
+  my $parent = $tree->[3];
298
+  splice @$parent, _parent($parent, $tree), 1, _link($new, $parent);
299
+  return $self->parent;
300
+}
301
+
302
+sub _select {
303
+  my ($self, $selector) = @_;
304
+  return defined $selector ? $self->grep(sub { $_->match($selector) }) : $self;
305
+}
306
+
307
+sub _siblings {
308
+  my ($self, $merge) = @_;
298 309
 
299
-  # Make sure we have a parent
300
-  return undef unless my $parent = $self->parent;
310
+  return $merge ? [] : [[], []] unless my $parent = $self->parent;
301 311
 
302
-  # Find previous or next sibling
303
-  my ($previous, $current);
312
+  my $tree = $self->tree;
313
+  my (@before, @after, $match);
304 314
   for my $child ($parent->children->each) {
305
-    ++$current and next if $child->tree eq $self->tree;
306
-    return $next ? $child : $previous if $current;
307
-    $previous = $child;
315
+    ++$match and next if $child->tree eq $tree;
316
+    $match ? push @after, $child : push @before, $child;
308 317
   }
309 318
 
310
-  # No siblings
311
-  return undef;
319
+  return $merge ? [@before, @after] : [\@before, \@after];
312 320
 }
313 321
 
314 322
 sub _text {
315
-  my ($elements, $recurse, $trim) = @_;
323
+  my ($nodes, $recurse, $trim) = @_;
324
+
325
+  # Merge successive text nodes
326
+  my $i = 0;
327
+  while (my $next = $nodes->[$i + 1]) {
328
+    ++$i and next unless $nodes->[$i][0] eq 'text' && $next->[0] eq 'text';
329
+    splice @$nodes, $i, 2, ['text', $nodes->[$i][1] . $next->[1]];
330
+  }
316 331
 
317 332
   my $text = '';
318
-  for my $e (@$elements) {
319
-    my $type = $e->[0];
333
+  for my $n (@$nodes) {
334
+    my $type = $n->[0];
320 335
 
321 336
     # Nested tag
322 337
     my $content = '';
323 338
     if ($type eq 'tag' && $recurse) {
324
-      $content = _text(_elements($e), 1, _trim($e, $trim));
339
+      $content = _text([_nodes($n)], 1, _trim($n, $trim));
325 340
     }
326 341
 
327 342
     # Text
328
-    elsif ($type eq 'text') { $content = $trim ? squish($e->[1]) : $e->[1] }
343
+    elsif ($type eq 'text') { $content = $trim ? squish($n->[1]) : $n->[1] }
329 344
 
330 345
     # CDATA or raw text
331
-    elsif ($type eq 'cdata' || $type eq 'raw') { $content = $e->[1] }
346
+    elsif ($type eq 'cdata' || $type eq 'raw') { $content = $n->[1] }
332 347
 
333 348
     # Add leading whitespace if punctuation allows it
334 349
     $content = " $content" if $text =~ /\S\z/ && $content =~ /^[^.!?,;:\s]+/;
... ...
@@ -357,6 +372,8 @@ sub _trim {
357 372
 
358 373
 1;
359 374
 
375
+=encoding utf8
376
+
360 377
 =head1 NAME
361 378
 
362 379
 Mojo::DOM - Minimalistic HTML/XML DOM parser with CSS selectors
... ...
@@ -370,7 +387,8 @@ Mojo::DOM - Minimalistic HTML/XML DOM parser with CSS selectors
370 387
 
371 388
   # Find
372 389
   say $dom->at('#b')->text;
373
-  say $dom->find('p')->pluck('text');
390
+  say $dom->find('p')->text;
391
+  say $dom->find('[id]')->attr('id');
374 392
 
375 393
   # Walk
376 394
   say $dom->div->p->[0]->text;
... ...
@@ -386,6 +404,7 @@ Mojo::DOM - Minimalistic HTML/XML DOM parser with CSS selectors
386 404
 
387 405
   # Modify
388 406
   $dom->div->p->[1]->append('<p id="c">C</p>');
407
+  $dom->find(':not(p)')->strip;
389 408
 
390 409
   # Render
391 410
   say "$dom";
... ...
@@ -399,7 +418,7 @@ use it for validation.
399 418
 =head1 CASE SENSITIVITY
400 419
 
401 420
 L<Mojo::DOM> defaults to HTML semantics, that means all tags and attributes
402
-are lowercased and selectors need to be lower case as well.
421
+are lowercased and selectors need to be lowercase as well.
403 422
 
404 423
   my $dom = Mojo::DOM->new('<P ID="greeting">Hi!</P>');
405 424
   say $dom->at('p')->text;
... ...
@@ -412,7 +431,7 @@ into XML mode and everything becomes case sensitive.
412 431
   say $dom->at('P')->text;
413 432
   say $dom->P->{ID};
414 433
 
415
-XML detection can also be disabled with the C<xml> method.
434
+XML detection can also be disabled with the L</"xml"> method.
416 435
 
417 436
   # Force XML semantics
418 437
   $dom->xml(1);
... ...
@@ -422,16 +441,15 @@ XML detection can also be disabled with the C<xml> method.
422 441
 
423 442
 =head1 METHODS
424 443
 
425
-L<Mojo::DOM> inherits all methods from L<Mojo::Base> and implements the
426
-following new ones.
444
+L<Mojo::DOM> implements the following methods.
427 445
 
428 446
 =head2 new
429 447
 
430 448
   my $dom = Mojo::DOM->new;
431 449
   my $dom = Mojo::DOM->new('<foo bar="baz">test</foo>');
432 450
 
433
-Construct a new array-based L<Mojo::DOM> object and C<parse> HTML/XML document
434
-if necessary.
451
+Construct a new array-based L<Mojo::DOM> object and L</"parse"> HTML/XML
452
+fragment if necessary.
435 453
 
436 454
 =head2 all_text
437 455
 
... ...
@@ -447,11 +465,23 @@ enabled by default.
447 465
   # "foo\nbarbaz\n"
448 466
   $dom->parse("<div>foo\n<p>bar</p>baz\n</div>")->div->all_text(0);
449 467
 
468
+=head2 ancestors
469
+
470
+  my $collection = $dom->ancestors;