@@ -0,0 +1,2 @@

+mojo-legacy 4.57

+https://github.com/jamadam/mojo-legacy

@@ -15,10 +15,10 @@ has log  => sub { Mojo::Log->new };

 has ua   => sub {

   my $self = shift;

-  my $ua = Mojo::UserAgent->new->app($self);

+  my $ua = Mojo::UserAgent->new;

+  weaken $ua->server->app($self)->{app};

   weaken $self;

   $ua->on(error => sub { $self->log->error($_[1]) });

-  weaken $ua->{app};

   return $ua;

 };

@@ -27,7 +27,8 @@ sub new {

   my $self = shift->SUPER::new(@_);

   # Check if we have a log directory

-  my $home = $self->home->detect(ref $self);

+  my $home = $self->home;

+  $home->detect(ref $self) unless @{$home->parts};

   $self->log->path($home->rel_file('log/mojo.log'))

     if -w $home->rel_file('log');

@@ -58,6 +59,8 @@ sub _dict {

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo - Duct tape for the HTML5 web!

@@ -92,7 +95,7 @@ frameworks. It provides all the basic tools and helpers needed to write

 simple web applications and higher level web frameworks, such as

 L<Mojolicious>.

-See L<Mojolicious> for more!

+See L<Mojolicious::Guides> for more!

 =head1 ATTRIBUTES

@@ -130,7 +133,7 @@ plugins, since non-blocking requests that are already in progress will

 interfere with new blocking ones.

   # Perform blocking request

-  my $body = $app->ua->get('example.com')->res->body;

+  say $app->ua->get('example.com')->res->body;

 =head1 METHODS

@@ -142,7 +145,8 @@ new ones.

   my $app = Mojo->new;

 Construct a new L<Mojo> application. Will automatically detect your home

-directory and set up logging to C<log/mojo.log> if there's a C<log> directory.

+directory if necessary and set up logging to C<log/mojo.log> if there's a

+C<log> directory.

 =head2 build_tx

@@ -20,6 +20,8 @@ sub slurp   { croak 'Method "slurp" not implemented by subclass' }

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Asset - HTTP content storage base class

@@ -58,7 +60,7 @@ Pretend file ends earlier.

 =head2 start_range

   my $start = $asset->start_range;

-  $asset    = $asset->start_range(0);

+  $asset    = $asset->start_range(3);

 Pretend file starts later.

@@ -96,9 +98,9 @@ False.

 =head2 is_range

-  my $success = $asset->is_range;

+  my $bool = $asset->is_range;

-Check if asset has a C<start_range> or C<end_range>.

+Check if asset has a L</"start_range"> or L</"end_range">.

 =head2 move_to

@@ -26,7 +26,7 @@ has handle => sub {

   my $name = defined $path ? $path : $base;

   until ($handle->open($name, O_CREAT | O_EXCL | O_RDWR)) {

     croak qq{Can't open file "$name": $!} if defined $path || $! != $!{EEXIST};

-    $name = "$base." . md5_sum(time . $$ . rand 9999999);

+    $name = "$base." . md5_sum(time . $$ . rand 9 x 7);

   }

   $self->path($name);

@@ -140,6 +140,8 @@ sub slurp {

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Asset::File - File storage for HTTP content

@@ -174,8 +176,8 @@ implements the following new ones.

 =head2 cleanup

-  my $cleanup = $file->cleanup;

-  $file       = $file->cleanup(1);

+  my $bool = $file->cleanup;

+  $file    = $file->cleanup($bool);

 Delete file automatically once it's not used anymore.

@@ -184,14 +186,14 @@ Delete file automatically once it's not used anymore.

   my $handle = $file->handle;

   $file      = $file->handle(IO::File->new);

-File handle, created on demand.

+Filehandle, created on demand.

 =head2 path

   my $path = $file->path;

   $file    = $file->path('/home/sri/foo.txt');

-File path used to create C<handle>, can also be automatically generated if

+File path used to create L</"handle">, can also be automatically generated if

 necessary.

 =head2 tmpdir

@@ -199,7 +201,7 @@ necessary.

   my $tmpdir = $file->tmpdir;

   $file      = $file->tmpdir('/tmp');

-Temporary directory used to generate C<path>, defaults to the value of the

+Temporary directory used to generate L</"path">, defaults to the value of the

 MOJO_TMPDIR environment variable or auto detection.

 =head1 METHODS

@@ -237,7 +239,7 @@ True.

   $file = $file->move_to('/home/sri/bar.txt');

-Move asset data into a specific file and disable C<cleanup>.

+Move asset data into a specific file and disable L</"cleanup">.

 =head2 size

@@ -55,6 +55,8 @@ sub slurp { shift->{content} }

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Asset::Memory - In-memory storage for HTTP content

@@ -97,10 +99,10 @@ implements the following new ones.

 =head2 auto_upgrade

-  my $upgrade = $mem->auto_upgrade;

-  $mem        = $mem->auto_upgrade(1);

+  my $bool = $mem->auto_upgrade;

+  $mem     = $mem->auto_upgrade($bool);

-Try to detect if content size exceeds C<max_memory_size> limit and

+Try to detect if content size exceeds L</"max_memory_size"> limit and

 automatically upgrade to a L<Mojo::Asset::File> object.

 =head2 max_memory_size

@@ -14,7 +14,6 @@ use IO::Handle ();

 sub import {

   my $class = shift;

   return unless my $flag = shift;

-  no strict 'refs';

   # Base

   if ($flag eq '-base') { $flag = $class }

@@ -23,21 +22,24 @@ sub import {

   elsif ($flag eq '-strict') { $flag = undef }

   # Module

-  else {

-    my $file = $flag;

-    $file =~ s/::|'/\//g;

-    require "$file.pm" unless $flag->can('new');

+  elsif ((my $file = $flag) && !$flag->can('new')) {

+    $file =~ s!::|'!/!g;

+    require "$file.pm";

   }

   # ISA

   if ($flag) {

     my $caller = caller;

+    no strict 'refs';

     push @{"${caller}::ISA"}, $flag;

     *{"${caller}::has"} = sub { attr($caller, @_) };

   }

   my $caller = caller;

-  *{"${caller}::say"} = sub { say(@_) };

+  {

+    no strict 'refs';

+    *{"${caller}::say"} = sub { say(@_) };

+  }

   # Mojo modules are strict!

   strict->import;

@@ -51,9 +53,6 @@ sub new {

   bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;

 }

-# Performance is very important for something as often used as accessors,

-# so we optimize them by compiling our own code, don't be scared, we have

-# tests for every single case

 sub attr {

   my ($class, $attrs, $default) = @_;

   return unless ($class = ref $class || $class) && $attrs;

@@ -61,7 +60,6 @@ sub attr {

   Carp::croak 'Default has to be a code reference or constant value'

     if ref $default && ref $default ne 'CODE';

-  # Compile attributes

   for my $attr (@{ref $attrs eq 'ARRAY' ? $attrs : [$attrs]}) {

     Carp::croak qq{Attribute "$attr" invalid} unless $attr =~ /^[a-zA-Z_]\w*$/;

@@ -89,8 +87,6 @@ sub attr {

     # Footer (return invocant)

     $code .= "  \$_[0];\n}";

-    # We compile custom attribute code for speed

-    no strict 'refs';

     warn "-- Attribute $attr in $class\n$code\n\n" if $ENV{MOJO_BASE_DEBUG};

     Carp::croak "Mojo::Base error: $@" unless eval "$code;1";

   }

@@ -104,6 +100,8 @@ sub tap {

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Base - Minimal base class for Mojo projects

@@ -185,7 +183,7 @@ flag or a base class.

   has [qw(name1 name2 name3)] => 'foo';

   has [qw(name1 name2 name3)] => sub {...};

-Create attributes for hash-based objects, just like the C<attr> method.

+Create attributes for hash-based objects, just like the L</"attr"> method.

 =head1 METHODS

@@ -222,8 +220,8 @@ argument.

   $object = $object->tap(sub {...});

 K combinator, tap into a method chain to perform operations on an object

-within the chain. The object will be the first argument passed to the closure

-and is also available via C<$_>.

+within the chain. The object will be the first argument passed to the callback

+and is also available as C<$_>.

 =head2 C<say>

@@ -1,5 +1,5 @@

 package Mojo::ByteStream;

-use Mojo::Base -base;

+use Mojo::Base -strict;

 use overload '""' => sub { shift->to_string }, fallback => 1;

 use Exporter 'import';

@@ -63,10 +63,14 @@ sub split {

   return Mojo::Collection->new(map { $self->new($_) } split $pattern, $$self);

 }

+sub tap { shift->Mojo::Base::tap(@_) }

+

 sub to_string { ${$_[0]} }

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::ByteStream - ByteStream

@@ -104,8 +108,7 @@ Construct a new scalar-based L<Mojo::ByteStream> object.

 =head1 METHODS

-L<Mojo::ByteStream> inherits all methods from L<Mojo::Base> and implements the

-following new ones.

+L<Mojo::ByteStream> implements the following methods.

 =head2 new

@@ -219,7 +222,7 @@ Print bytestream to handle and append a newline, defaults to C<STDOUT>.

 =head2 secure_compare

-  my $success = $stream->secure_compare($str);

+  my $bool = $stream->secure_compare($str);

 Compare bytestream with L<Mojo::Util/"secure_compare">.

@@ -263,9 +266,10 @@ Write all data from bytestream at once to file with L<Mojo::Util/"spurt">.

   my $collection = $stream->split(',');

-Turn bytestream into L<Mojo::Collection>.

+Turn bytestream into L<Mojo::Collection> object containing L<Mojo::ByteStream>

+objects.

-  b('a,b,c')->split(',')->pluck('quote')->join(',')->say;

+  b('a,b,c')->split(',')->quote->join(',')->say;

 =head2 squish

@@ -275,6 +279,12 @@ Trim whitespace characters from both ends of bytestream and then change all

 consecutive groups of whitespace into one space each with

 L<Mojo::Util/"squish">.

+=head2 tap

+

+  $stream = $stream->tap(sub {...});

+

+Alias for L<Mojo::Base/"tap">.

+

 =head2 to_string

   my $str = $stream->to_string;

@@ -327,6 +337,12 @@ bytestream with L<Mojo::Util/"xml_escape">.

 XOR encode bytestream with L<Mojo::Util/"xor_encode">.

+=head1 BYTESTREAM

+

+Direct scalar reference access to the bytestream is also possible.

+

+  $$stream .= 'foo';

+

 =head1 SEE ALSO

 L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.

@@ -19,6 +19,8 @@ sub set {

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Cache - Naive in-memory cache

@@ -1,16 +1,29 @@

 package Mojo::Collection;

-use Mojo::Base -base;

-use overload

-  'bool'   => sub {1},

-  '""'     => sub { shift->join("\n") },

-  fallback => 1;

+use Mojo::Base -strict;

+use overload bool => sub {1}, '""' => sub { shift->join("\n") }, fallback => 1;

+use Carp 'croak';

 use Exporter 'import';

 use List::Util;

 use Mojo::ByteStream;

+use Scalar::Util 'blessed';

 our @EXPORT_OK = ('c');

+sub AUTOLOAD {

+  my $self = shift;

+

+  my ($package, $method) = our $AUTOLOAD =~ /^([\w:]+)::(\w+)$/;

+  croak "Undefined subroutine &${package}::$method called"

+    unless blessed $self && $self->isa(__PACKAGE__);

+

+  croak qq{Can't locate object method "$method" via package "$package"}

+    unless @$self;

+  return $self->pluck($method, @_);

+}

+

+sub DESTROY { }

+

 sub new {

   my $class = shift;

   return bless [@_], ref $class || $class;

@@ -18,6 +31,10 @@ sub new {

 sub c { __PACKAGE__->new(@_) }

+sub compact {

+  shift->grep(sub { length(defined $_ ? $_ : '') });

+}

+

 sub each {

   my ($self, $cb) = @_;

   return @$self unless $cb;

@@ -33,16 +50,15 @@ sub first {

   return List::Util::first { $_ =~ $cb } @$self;

 }

+sub flatten { $_[0]->new(_flatten(@{$_[0]})) }

+

 sub grep {

   my ($self, $cb) = @_;

   return $self->new(grep { $cb->($_) } @$self) if ref $cb eq 'CODE';

   return $self->new(grep { $_ =~ $cb } @$self);

 }

-sub join {

-  my ($self, $expr) = @_;

-  return Mojo::ByteStream->new(join $expr, map({"$_"} @$self));

-}

+sub join { Mojo::ByteStream->new(join $_[1], map({"$_"} @{$_[0]})) }

 sub map {

   my ($self, $cb) = @_;

@@ -54,15 +70,9 @@ sub pluck {

   return $self->map(sub { $_->$method(@args) });

 }

-sub reverse {

-  my $self = shift;

-  return $self->new(reverse @$self);

-}

+sub reverse { $_[0]->new(reverse @{$_[0]}) }

-sub shuffle {

-  my $self = shift;

-  return $self->new(List::Util::shuffle @$self);

-}

+sub shuffle { $_[0]->new(List::Util::shuffle @{$_[0]}) }

 sub size { scalar @{$_[0]} }

@@ -76,14 +86,24 @@ sub sort {

   return $self->new($cb ? sort { $a->$cb($b) } @$self : sort @$self);

 }

+sub tap { shift->Mojo::Base::tap(@_) }

+

 sub uniq {

   my $self = shift;

   my %seen;

   return $self->grep(sub { !$seen{$_}++ });

 }

+sub _flatten {

+  map { _ref($_) ? _flatten(@$_) : $_ } @_;

+}

+

+sub _ref { ref $_[0] && (ref $_[0] eq 'ARRAY' || $_[0]->isa(__PACKAGE__)) }

+

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Collection - Collection

@@ -119,8 +139,7 @@ Construct a new array-based L<Mojo::Collection> object.

 =head1 METHODS

-L<Mojo::Collection> inherits all methods from L<Mojo::Base> and implements the

-following new ones.

+L<Mojo::Collection> implements the following methods.

 =head2 new

@@ -128,12 +147,21 @@ following new ones.

 Construct a new array-based L<Mojo::Collection> object.

+=head2 compact

+

+  my $new = $collection->compact;

+

+Create a new collection with all elements that are defined and not an empty

+string.

+

 =head2 each

   my @elements = $collection->each;

   $collection  = $collection->each(sub {...});

-Evaluate callback for each element in collection.

+Evaluate callback for each element in collection or return all elements as a

+list if none has been provided. The element will be the first argument passed

+to the callback and is also available as C<$_>.

   $collection->each(sub {

     my ($e, $count) = @_;

@@ -148,10 +176,18 @@ Evaluate callback for each element in collection.

 Evaluate regular expression or callback for each element in collection and

 return the first one that matched the regular expression, or for which the

-callback returned true.

+callback returned true. The element will be the first argument passed to the

+callback and is also available as C<$_>.

   my $five = $collection->first(sub { $_ == 5 });

+=head2 flatten

+

+  my $new = $collection->flatten;

+

+Flatten nested collections/arrays recursively and create a new collection with

+all elements.

+

 =head2 grep

   my $new = $collection->grep(qr/foo/);

@@ -159,7 +195,8 @@ callback returned true.

 Evaluate regular expression or callback for each element in collection and

 create a new collection with all elements that matched the regular expression,

-or for which the callback returned true.

+or for which the callback returned true. The element will be the first

+argument passed to the callback and is also available as C<$_>.

   my $interesting = $collection->grep(qr/mojo/i);

@@ -176,7 +213,8 @@ Turn collection into L<Mojo::ByteStream>.

   my $new = $collection->map(sub {...});

 Evaluate callback for each element in collection and create a new collection

-from the results.

+from the results. The element will be the first argument passed to the

+callback and is also available as C<$_>.

   my $doubled = $collection->map(sub { $_ * 2 });

@@ -225,12 +263,27 @@ from the results.

   my $insensitive = $collection->sort(sub { uc(shift) cmp uc(shift) });

+=head2 tap

+

+  $collection = $collection->tap(sub {...});

+

+Alias for L<Mojo::Base/"tap">.

+

 =head2 uniq

   my $new = $collection->uniq;

 Create a new collection without duplicate elements.

+=head1 ELEMENT METHODS

+

+In addition to the methods above, you can also call methods provided by all

+elements in the collection directly and create a new collection from the

+results, similar to L</"pluck">.

+

+  push @$collection, Mojo::DOM->new("<div><h1>$_</h1></div>") for 1 .. 9;

+  say $collection->at('h1')->type('h2')->prepend_content('Test ')->root;

+

 =head1 ELEMENTS

 Direct array reference access to elements is also possible.

@@ -18,7 +18,7 @@ sub body_size { croak 'Method "body_size" not implemented by subclass' }

 sub boundary {

   return undef unless my $type = shift->headers->content_type;

-  $type =~ m!multipart.*boundary=(?:"([^"]+)"|([\w'(),.:?\-+/]+))!i

+  $type =~ m!multipart.*boundary\s*=\s*(?:"([^"]+)"|([\w'(),.:?\-+/]+))!i

     and return defined $1 ? $1 : $2;

   return undef;

 }

@@ -27,8 +27,8 @@ sub build_body    { shift->_build('get_body_chunk') }

 sub build_headers { shift->_build('get_header_chunk') }

 sub charset {

-  my $type = do {my $tmp = shift->headers->content_type; defined $tmp ? $tmp : ''};

-  return $type =~ /charset="?([^"\s;]+)"?/i ? $1 : undef;

+  my $type = do { my $type = shift->headers->content_type; defined $type ? $type : ''};

+  return $type =~ /charset\s*=\s*"?([^"\s;]+)"?/i ? $1 : undef;

 }

 sub clone {

@@ -220,7 +220,7 @@ sub _parse_chunked {

     # Start new chunk (ignore the chunk extension)

     unless ($self->{chunk_len}) {

       last

-        unless $self->{pre_buffer} =~ s/^(?:\x0d?\x0a)?([[:xdigit:]]+).*\x0a//;

+        unless $self->{pre_buffer} =~ s/^(?:\x0d?\x0a)?([0-9a-fA-F]+).*\x0a//;

       next if $self->{chunk_len} = hex $1;

       # Last chunk

@@ -306,6 +306,8 @@ sub _uncompress {

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Content - HTTP content base class

@@ -378,8 +380,8 @@ L<Mojo::Content> implements the following attributes.

 =head2 auto_relax

-  my $relax = $content->auto_relax;

-  $content  = $content->auto_relax(1);

+  my $bool = $content->auto_relax;

+  $content = $content->auto_relax($bool);

 Try to detect when relaxed parsing is necessary.

@@ -408,16 +410,16 @@ value of the MOJO_MAX_LEFTOVER_SIZE environment variable or C<262144>.

 =head2 relaxed

-  my $relaxed = $content->relaxed;

-  $content    = $content->relaxed(1);

+  my $bool = $content->relaxed;

+  $content = $content->relaxed($bool);

 Activate relaxed parsing for responses that are terminated with a connection

 close.

 =head2 skip_body

-  my $skip = $content->skip_body;

-  $content = $content->skip_body(1);

+  my $bool = $content->skip_body;

+  $content = $content->skip_body($bool);

 Skip body parsing and finish after headers.

@@ -428,7 +430,7 @@ implements the following new ones.

 =head2 body_contains

-  my $success = $content->body_contains('foo bar baz');

+  my $bool = $content->body_contains('foo bar baz');

 Check if content contains a specific string. Meant to be overloaded in a

 subclass.

@@ -496,34 +498,34 @@ Size of headers in bytes.

 =head2 is_chunked

-  my $success = $content->is_chunked;

+  my $bool = $content->is_chunked;

 Check if content is chunked.

 =head2 is_compressed

-  my $success = $content->is_compressed;

+  my $bool = $content->is_compressed;

 Check if content is C<gzip> compressed.

 =head2 is_dynamic

-  my $success = $content->is_dynamic;

+  my $bool = $content->is_dynamic;

-Check if content will be dynamically generated, which prevents C<clone> from

-working.

+Check if content will be dynamically generated, which prevents L</"clone">

+from working.

 =head2 is_finished

-  my $success = $content->is_finished;

+  my $bool = $content->is_finished;

 Check if parser is finished.

 =head2 is_limit_exceeded

-  my $success = $content->is_limit_exceeded;

+  my $bool = $content->is_limit_exceeded;

-Check if buffer has exceeded C<max_buffer_size>.

+Check if buffer has exceeded L</"max_buffer_size">.

 =head2 is_multipart

@@ -533,7 +535,7 @@ False.

 =head2 is_parsing_body

-  my $success = $content->is_parsing_body;

+  my $bool = $content->is_parsing_body;

 Check if body parsing started yet.

@@ -45,7 +45,7 @@ sub build_boundary {

   my $boundary;

   my $size = 1;

   while (1) {

-    $boundary = b64_encode join('', map chr(rand(256)), 1 .. $size++ * 3);

+    $boundary = b64_encode join('', map chr(rand 256), 1 .. $size++ * 3);

     $boundary =~ s/\W/X/g;

     last unless $self->body_contains($boundary);

   }

@@ -199,6 +199,8 @@ sub _read {

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Content::MultiPart - HTTP multipart content

@@ -258,12 +260,12 @@ implements the following new ones.

   my $multi = Mojo::Content::MultiPart->new;

-Construct a new L<Mojo::Content::MultiPart> object and subscribe to C<read>

+Construct a new L<Mojo::Content::MultiPart> object and subscribe to L</"read">

 event with default content parser.

 =head2 body_contains

-  my $success = $multi->body_contains('foobarbaz');

+  my $bool = $multi->body_contains('foobarbaz');

 Check if content parts contain a specific string.

@@ -46,13 +46,15 @@ sub parse {

   # Content needs to be upgraded to multipart

   $self->unsubscribe(read => $self->{read});

-  my $multi = Mojo::Content::MultiPart->new($self);

+  my $multi = Mojo::Content::MultiPart->new(%$self);

   $self->emit(upgrade => $multi);

   return $multi->parse;

 }

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Content::Single - HTTP content

@@ -120,12 +122,12 @@ implements the following new ones.

   my $single = Mojo::Content::Single->new;

-Construct a new L<Mojo::Content::Single> object and subscribe to C<read> event

-with default content parser.

+Construct a new L<Mojo::Content::Single> object and subscribe to L</"read">

+event with default content parser.

 =head2 body_contains

-  my $success = $single->body_contains('1234567');

+  my $bool = $single->body_contains('1234567');

 Check if content contains a specific string.

@@ -1,47 +1,18 @@

 package Mojo::Cookie;

 use Mojo::Base -base;

-use overload

-  'bool'   => sub {1},

-  '""'     => sub { shift->to_string },

-  fallback => 1;

+use overload bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1;

 use Carp 'croak';

-use Mojo::Util 'unquote';

 has [qw(name value)];

 sub parse     { croak 'Method "parse" not implemented by subclass' }

 sub to_string { croak 'Method "to_string" not implemented by subclass' }

-sub _tokenize {

-  my ($self, $str) = @_;

-

-  # Nibbling parser

-  my (@tree, @token);

-  while ($str =~ s/^\s*([^=;,]+)\s*=?\s*//) {

-    my $name = $1;

-

-    # "expires" is a special case, thank you Netscape...

-    $str =~ s/^([^;,]+,?[^;,]+)/"$1"/ if $name =~ /^expires$/i;

-

-    # Value

-    my $value;

-    $value = unquote $1 if $str =~ s/^("(?:\\\\|\\"|[^"])+"|[^;,]+)\s*//;

-    push @token, [$name, $value];

-

-    # Separator

-    $str =~ s/^\s*;\s*//;

-    next unless $str =~ s/^\s*,\s*//;

-    push @tree, [@token];

-    @token = ();

-  }

-

-  # Take care of final token

-  return @token ? (@tree, \@token) : @tree;

-}

-

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Cookie - HTTP cookie base class

@@ -1,14 +1,15 @@

 package Mojo::Cookie::Request;

 use Mojo::Base 'Mojo::Cookie';

-use Mojo::Util 'quote';

+use Mojo::Util qw(quote split_header);

 sub parse {

   my ($self, $str) = @_;

   my @cookies;

-  for my $token (map {@$_} $self->_tokenize(defined $str ? $str : '')) {

-    my ($name, $value) = @$token;

+  my @pairs = map {@$_} @{split_header(defined $str? $str: '')};

+  while (@pairs) {

+    my ($name, $value) = (shift @pairs, shift @pairs);

     next if $name =~ /^\$/;

     push @cookies, $self->new(name => $name, value => defined $value ? $value : '');

   }

@@ -18,14 +19,15 @@ sub parse {

 sub to_string {

   my $self = shift;

-  return '' unless my $name = $self->name;

+  return '' unless length(my $name = defined $self->name ? $self->name : '');

   my $value = defined $self->value ? $self->value : '';

-  $value = $value =~ /[,;"]/ ? quote($value) : $value;

-  return "$name=$value";

+  return join '=', $name, $value =~ /[,;" ]/ ? quote($value) : $value;

 }

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Cookie::Request - HTTP request cookie

@@ -2,9 +2,9 @@ package Mojo::Cookie::Response;

 use Mojo::Base 'Mojo::Cookie';

 use Mojo::Date;

-use Mojo::Util 'quote';

+use Mojo::Util qw(quote split_header);

-has [qw(domain httponly max_age path secure)];

+has [qw(domain httponly max_age origin path secure)];

 sub expires {

   my $self = shift;

@@ -22,21 +22,29 @@ sub parse {

   my ($self, $str) = @_;

   my @cookies;

-  for my $token ($self->_tokenize(defined $str ? $str : '')) {

-    for my $i (0 .. $#$token) {

-      my ($name, $value) = @{$token->[$i]};

+  my $tree = split_header(defined $str ? $str : '');

+  while (my $pairs = shift @$tree) {

+    my $i = 0;

+    while (@$pairs) {

+      my ($name, $value) = (shift @$pairs, shift @$pairs);

+

+      # "expires" is a special case, thank you Netscape...

+      if ($name =~ /^expires$/i) {

+        push @$pairs, @{my $elem = shift @$tree; defined $elem ? $elem : []};

+        my $len = (defined $pairs->[0] ? $pairs->[0] : '') =~ /-/ ? 6 : 10;

+        $value .= join ' ', ',', grep {defined} splice @$pairs, 0, $len;

+      }

       # This will only run once

       push @cookies, $self->new(name => $name, value => defined $value ? $value : '') and next

-        unless $i;

+        unless $i++;

       # Attributes (Netscape and RFC 6265)

-      my @match

-        = $name =~ /^(expires|domain|path|secure|Max-Age|HttpOnly)$/msi;

-      next unless @match;

-      my $attr = lc $match[0];

-      $attr =~ tr/-/_/;

-      $cookies[-1]->$attr($attr =~ /(?:secure|HttpOnly)/i ? 1 : $value);

+      next unless $name =~ /^(expires|domain|path|secure|max-age|httponly)$/i;

+      my $attr = lc $1;

+      $attr = 'max_age' if $attr eq 'max-age';

+      $cookies[-1]

+        ->$attr($attr eq 'secure' || $attr eq 'httponly' ? 1 : $value);

     }

   }

@@ -47,10 +55,9 @@ sub to_string {

   my $self = shift;

   # Name and value (Netscape)

-  return '' unless my $name = $self->name;

+  return '' unless length(my $name = defined $self->name ? $self->name : '');

   my $value = defined $self->value ? $self->value : '';

-  $value = $value =~ /[,;"]/ ? quote($value) : $value;

-  my $cookie = "$name=$value";

+  my $cookie = join '=', $name, $value =~ /[,;" ]/ ? quote($value) : $value;

   # "expires" (Netscape)

   if (defined(my $e = $self->expires)) { $cookie .= "; expires=$e" }

@@ -62,19 +69,21 @@ sub to_string {

   if (my $path = $self->path) { $cookie .= "; path=$path" }

   # "secure" (Netscape)

-  if (my $secure = $self->secure) { $cookie .= "; secure" }

+  $cookie .= "; secure" if $self->secure;

   # "Max-Age" (RFC 6265)

-  if (defined(my $m = $self->max_age)) { $cookie .= "; Max-Age=$m" }

+  if (defined(my $max = $self->max_age)) { $cookie .= "; Max-Age=$max" }

   # "HttpOnly" (RFC 6265)

-  if (my $httponly = $self->httponly) { $cookie .= "; HttpOnly" }

+  $cookie .= "; HttpOnly" if $self->httponly;

   return $cookie;

 }

 1;

+=encoding utf8

+

 =head1 NAME

 Mojo::Cookie::Response - HTTP response cookie

@@ -107,8 +116,8 @@ Cookie domain.

 =head2 httponly

-  my $httponly = $cookie->httponly;

-  $cookie      = $cookie->httponly(1);

+  my $bool = $cookie->httponly;

+  $cookie  = $cookie->httponly($bool);

 HttpOnly flag, which can prevent client-side scripts from accessing this

 cookie.

@@ -120,6 +129,13 @@ cookie.

 Max age for cookie.

+=head2 origin

+

+  my $origin = $cookie->origin;

+  $cookie    = $cookie->origin('mojolicio.us');

+

+Origin of the cookie.

+

 =head2 path

   my $path = $cookie->path;

@@ -129,8 +145,8 @@ Cookie path.

 =head2 secure

-  my $secure = $cookie->secure;

-  $cookie    = $cookie->secure(1);

+  my $bool = $cookie->secure;

+  $cookie  = $cookie->secure($bool);

 Secure flag, which instructs browsers to only send this cookie over HTTPS

 connections.

@@ -1,8 +1,8 @@

 package Mojo::DOM;

-use Mojo::Base -base;

+use Mojo::Base -strict;

 use overload

-  '%{}'    => sub { shift->attrs },

-  'bool'   => sub {1},

+  '%{}'    => sub { shift->attr },

+  bool     => sub {1},

   '""'     => sub { shift->to_xml },

   fallback => 1;

@@ -36,23 +36,22 @@ sub new {

   return @_ ? $self->parse(@_) : $self;

 }

-sub all_text {

-  my $tree = shift->tree;

-  return _text(_elements($tree), 1, _trim($tree, @_));

-}

+sub all_text { shift->_content(1, @_) }

+

+sub ancestors { _select($_[0]->_collect(_ancestors($_[0]->tree)), $_[1]) }

 sub append { shift->_add(1, @_) }

 sub append_content {

   my ($self, $new) = @_;

   my $tree = $self->tree;

-  push @$tree, @{_parent($self->_parse("$new"), $tree)};

+  push @$tree, _link($self->_parse("$new"), $tree);

   return $self;

 }

 sub at { shift->find(@_)->[0] }

-sub attrs {

+sub attr {

   my $self = shift;

   # Hash

@@ -70,45 +69,35 @@ sub attrs {

 }

 sub children {

-  my ($self, $type) = @_;

-

-  my @children;

-  my $xml  = $self->xml;

-  my $tree = $self->tree;

-  for my $e (@$tree[($tree->[0] eq 'root' ? 1 : 4) .. $#$tree]) {

-

-    # Make sure child is the right type

-    next if $e->[0] ne 'tag' || (defined $type && $e->[1] ne $type);

-    push @children, $self->new->tree($e)->xml($xml);

-  }

-

-  return Mojo::Collection->new(@children);

+  my $self = shift;

+  return _select(

+    $self->_collect(grep { $_->[0] eq 'tag' } _nodes($self->tree)), @_);

 }

 sub content_xml {

   my $self = shift;

-

-  # Render children individually

-  my $tree = $self->tree;

   my $xml  = $self->xml;

-  return join '',

-    map { Mojo::DOM::HTML->new(tree => $_, xml => $xml)->render }

-    @$tree[($tree->[0] eq 'root' ? 1 : 4) .. $#$tree];

+  return join '', map { _render($_, $xml) } _nodes($self->tree);

 }

 sub find {

-  my ($self, $selector) = @_;

-  my $xml = $self->xml;

-  my $results = Mojo::DOM::CSS->new(tree => $self->tree)->select($selector);

-  return Mojo::Collection->new(map { $self->new->tree($_)->xml($xml) }

-      @$results);

+  my $self = shift;

+  my $results = Mojo::DOM::CSS->new(tree => $self->tree)->select(@_);

+  return $self->_collect(@$results);

+}

+

+sub match {

+  my $self = shift;

+  return undef unless Mojo::DOM::CSS->new(tree => $self->tree)->match(@_);

+  return $self;

 }

 sub namespace {

   my $self = shift;

-  # Extract namespace prefix and search parents

   return '' if (my $current = $self->tree)->[0] eq 'root';

+

+  # Extract namespace prefix and search parents

   my $ns = $current->[1] =~ /^(.*?):/ ? "xmlns:$1" : undef;

   while ($current->[0] ne 'root') {

@@ -119,14 +108,13 @@ sub namespace {

     # Namespace attribute

     elsif (defined $attrs->{xmlns}) { return $attrs->{xmlns} }

-    # Parent

     $current = $current->[3];

   }

   return '';

 }

-sub next { shift->_sibling(1) }

+sub next { shift->_siblings->[1][0] }

 sub parent {

   my $self = shift;

@@ -134,201 +122,228 @@ sub parent {

   return $self->new->tree($tree->[3])->xml($self->xml);

 }

-sub parse { shift->_html(parse => shift) }

+sub parse { shift->_delegate(parse => shift) }

 sub prepend { shift->_add(0, @_) }

 sub prepend_content {

   my ($self, $new) = @_;

   my $tree = $self->tree;

-  splice @$tree, $tree->[0] eq 'root' ? 1 : 4, 0,

-    @{_parent($self->_parse("$new"), $tree)};

+  splice @$tree, _offset($tree), 0, _link($self->_parse("$new"), $tree);

   return $self;

 }

-sub previous { shift->_sibling(0) }

+sub previous { shift->_siblings->[0][-1] }

 sub remove { shift->replace('') }

 sub replace {

   my ($self, $new) = @_;

-

   my $tree = $self->tree;

-  if   ($tree->[0] eq 'root') { return $self->xml(undef)->parse($new) }

-  else                        { $new = $self->_parse("$new") }

-

-  my $parent = $tree->[3];

-  my $i = $parent->[0] eq 'root' ? 1 : 4;

-  for my $e (@$parent[$i .. $#$parent]) {

-    last if $e == $tree;

-    $i++;

-  }

-  splice @$parent, $i, 1, @{_parent($new, $parent)};

-

-  return $self;

+  return $self->xml(undef)->parse($new) if $tree->[0] eq 'root';

+  return $self->_replace($tree, $self->_parse("$new"));

 }

 sub replace_content {

   my ($self, $new) = @_;

   my $tree = $self->tree;

-  splice @$tree, $tree->[0] eq 'root' ? 1 : 4, $#$tree,

-    @{_parent($self->_parse("$new"), $tree)};

+  splice @$tree, _offset($tree), $#$tree, _link($self->_parse("$new"), $tree);

   return $self;