r71658 - in /branches/upstream/libmojolicious-perl/current: ./ lib/ lib/Mojo/ lib/Mojolicious/ lib/Mojolicious/Command/ lib/Mojolicious/Plugin/ lib/Test/ t/mojo/ t/mojolicious/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Mar 18 22:58:46 UTC 2011
Author: jawnsy-guest
Date: Fri Mar 18 22:58:40 2011
New Revision: 71658
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71658
Log:
[svn-upgrade] new version libmojolicious-perl (1.15)
Modified:
branches/upstream/libmojolicious-perl/current/Changes
branches/upstream/libmojolicious-perl/current/META.yml
branches/upstream/libmojolicious-perl/current/lib/Mojo.pm
branches/upstream/libmojolicious-perl/current/lib/Mojo/Base.pm
branches/upstream/libmojolicious-perl/current/lib/Mojo/DOM.pm
branches/upstream/libmojolicious-perl/current/lib/Mojo/Home.pm
branches/upstream/libmojolicious-perl/current/lib/Mojo/IOLoop.pm
branches/upstream/libmojolicious-perl/current/lib/Mojolicious.pm
branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Command/Inflate.pm
branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Controller.pm
branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/Config.pm
branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/DefaultHelpers.pm
branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/JsonConfig.pm
branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Renderer.pm
branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Routes.pm
branches/upstream/libmojolicious-perl/current/lib/Test/Mojo.pm
branches/upstream/libmojolicious-perl/current/t/mojo/dom.t
branches/upstream/libmojolicious-perl/current/t/mojo/home.t
branches/upstream/libmojolicious-perl/current/t/mojo/ioloop_online.t
branches/upstream/libmojolicious-perl/current/t/mojolicious/json_config_lite_app.t
Modified: branches/upstream/libmojolicious-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/Changes?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/Changes (original)
+++ branches/upstream/libmojolicious-perl/current/Changes Fri Mar 18 22:58:40 2011
@@ -1,4 +1,22 @@
This file documents the revision history for Perl extension Mojolicious.
+
+1.15 2011-03-18 00:00:00
+ - Changed default log level in "production" mode from "error" to
+ "info".
+ - Improved lookup method in Mojo::IOLoop.
+ - Fixed a serious Mojo::DOM bug. (moritz)
+
+1.14 2011-03-17 00:00:00
+ - Added support for multiple dns servers to Mojo::IOLoop.
+ - Added config helper to Mojolicious::Plugin::Config.
+ - Changed resolv.conf parser in Mojo::IOLoop to use the first
+ nameserver.
+ - Changed lookup method in Mojo::IOLoop to pick records randomly.
+ - Fixed small optional tag bugs in Mojo::DOM.
+ - Fixed JavaScript/CSS bug in Mojo::DOM.
+ - Fixed Windows home directory detection bug. (akron)
+ - Fixed a few warnings.
+ - Fixed typos.
1.13 2011-03-14 00:00:00
- Deprecated Mojo::Client in favor of the much sleeker
Modified: branches/upstream/libmojolicious-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/META.yml?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/META.yml (original)
+++ branches/upstream/libmojolicious-perl/current/META.yml Fri Mar 18 22:58:40 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Mojolicious
-version: 1.13
+version: 1.15
abstract: The Web In A Box!
author:
- Sebastian Riedel <sri at cpan.org>
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojo.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojo.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojo.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojo.pm Fri Mar 18 22:58:40 2011
@@ -25,8 +25,22 @@
return $ua;
};
+# "Oh, so they have internet on computers now!"
+sub new {
+ my $self = shift->SUPER::new(@_);
+
+ # Home
+ $self->home->detect(ref $self);
+
+ # Log directory
+ $self->log->path($self->home->rel_file('log/mojo.log'))
+ if -w $self->home->rel_file('log');
+
+ return $self;
+}
+
# DEPRECATED in Smiling Cat Face With Heart-Shaped Eyes!
-*client = sub {
+sub client {
warn <<EOF;
Mojo->client is DEPRECATED in favor of Mojo->us!!!
EOF
@@ -39,20 +53,6 @@
$client->log(shift->log);
return $client;
-};
-
-# "Oh, so they have internet on computers now!"
-sub new {
- my $self = shift->SUPER::new(@_);
-
- # Home
- $self->home->detect(ref $self);
-
- # Log directory
- $self->log->path($self->home->rel_file('log/mojo.log'))
- if -w $self->home->rel_file('log');
-
- return $self;
}
sub handler { croak 'Method "handler" not implemented in subclass' }
@@ -116,7 +116,7 @@
=head2 C<on_build_tx>
my $cb = $app->on_build_tx;
- $app = $app->on_build_tx(sub { ... });
+ $app = $app->on_build_tx(sub {...});
The transaction builder callback, by default it builds a
L<Mojo::Transaction::HTTP> object.
@@ -124,7 +124,7 @@
=head2 C<on_websocket>
my $cb = $app->on_websocket;
- $app = $app->on_websocket(sub { ... });
+ $app = $app->on_websocket(sub {...});
The websocket handshake callback, by default it builds a
L<Mojo::Transaction::WebSocket> object and handles the response for the
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojo/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojo/Base.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojo/Base.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojo/Base.pm Fri Mar 18 22:58:40 2011
@@ -196,9 +196,9 @@
has 'name';
has [qw/name1 name2 name3/];
has name => 'foo';
- has name => sub { ... };
+ has name => sub {...};
has [qw/name1 name2 name3/] => 'foo';
- has [qw/name1 name2 name3/] => sub { ... };
+ has [qw/name1 name2 name3/] => sub {...};
Create attributes, just like the C<attr> method.
@@ -220,9 +220,9 @@
__PACKAGE__->attr('name');
__PACKAGE__->attr([qw/name1 name2 name3/]);
__PACKAGE__->attr(name => 'foo');
- __PACKAGE__->attr(name => sub { ... });
+ __PACKAGE__->attr(name => sub {...});
__PACKAGE__->attr([qw/name1 name2 name3/] => 'foo');
- __PACKAGE__->attr([qw/name1 name2 name3/] => sub { ... });
+ __PACKAGE__->attr([qw/name1 name2 name3/] => sub {...});
Create attributes.
An arrayref can be used to create more than one attribute.
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojo/DOM.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojo/DOM.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojo/DOM.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojo/DOM.pm Fri Mar 18 22:58:40 2011
@@ -43,43 +43,40 @@
)?
/x;
my $XML_ATTR_RE = qr/
- ([^=\s]+) # Key
- (?:\s*=\s*(?:"([^"]*)"|'([^']*)'|(\S+)))? # Value
+ \s*
+ ([^=\s>"']+) # Key
+ (?:
+ \s*
+ =
+ \s*
+ (?:
+ "([^"]*?)" # Quotation marks
+ |
+ '([^']*?)' # Apostrophes
+ |
+ ([^>\s]+) # Unquoted
+ )
+ )?
+ \s*
/x;
my $XML_END_RE = qr/^\s*\/\s*(.+)\s*/;
my $XML_START_RE = qr/([^\s\/]+)([\s\S]*)/;
my $XML_TOKEN_RE = qr/
- ([^<]*) # Text
+ ([^<]*) # Text
(?:
- <\?(.*?)\?> # Processing Instruction
- |
- <\!--(.*?)--> # Comment
- |
- <\!\[CDATA\[(.*?)\]\]> # CDATA
- |
- <\!DOCTYPE([^>]*)> # DOCTYPE
- |
- <(
- \s*
- [^>\s]+ # Tag
- (?:
- \s*
- [^=\s>"']+ # Key
- (?:
+ <\?(.*?)\?> # Processing Instruction
+ |
+ <\!--(.*?)--> # Comment
+ |
+ <\!\[CDATA\[(.*?)\]\]> # CDATA
+ |
+ <\!DOCTYPE([^>]*)> # DOCTYPE
+ |
+ <(
\s*
- =
- \s*
- (?:
- "[^"]*?" # Quotation marks
- |
- '[^']*?' # Apostrophes
- |
- [^>\s]+ # Unquoted
- )
- )?
- \s*
- )*
- )>
+ [^>\s]+ # Tag
+ (?:$XML_ATTR_RE)* # Attributes
+ )>
)??
/xis;
@@ -120,7 +117,7 @@
unshift @stack, @$e[4 .. $#$e] and next if $type eq 'tag';
# Text or CDATA
- if ($type eq 'text' || $type eq 'cdata') {
+ if ($type eq 'text' || $type eq 'cdata' || $type eq 'raw') {
my $content = $e->[1];
$text .= $content if $content =~ /\S+/;
}
@@ -360,7 +357,7 @@
my $type = $e->[0];
# Text or CDATA
- if ($type eq 'text' || $type eq 'cdata') {
+ if ($type eq 'text' || $type eq 'cdata' || $type eq 'raw') {
my $content = $e->[1];
$text .= $content if $content =~ /\S+/;
}
@@ -444,17 +441,22 @@
push @$$current, ['cdata', $cdata];
}
-sub _close_table {
- my ($self, $current) = @_;
+sub _close {
+ my ($self, $current, $pattern, $stop) = @_;
+
+ # Default to table pattern
+ $pattern ||= qr/^(col|colgroup|tbody|td|th|thead|tr)$/;
+
+ # Default to table tag
+ $stop ||= 'table';
# Check parents
my $parent = $$current;
while ($parent) {
- last if $parent->[0] eq 'root' || $parent->[1] eq 'table';
+ last if $parent->[0] eq 'root' || $parent->[1] eq $stop;
# Match
- ($parent->[1] =~ qr/^(col|colgroup|tbody|td|th|thead|tr)$/)
- and $self->_end($1, $current);
+ ($parent->[1] =~ $pattern) and $self->_end($1, $current);
# Next
$parent = $parent->[3];
@@ -572,7 +574,7 @@
# Table
elsif ($end eq 'table') {
- $self->_close_table($current);
+ $self->_close($current);
next;
}
}
@@ -959,7 +961,7 @@
return $tree unless $xml;
# Tokenize
- while ($xml =~ /$XML_TOKEN_RE/g) {
+ while ($xml =~ m/\G$XML_TOKEN_RE/gcs) {
my $text = $1;
my $pi = $2;
my $comment = $3;
@@ -1025,6 +1027,14 @@
# Empty tag
$self->_end($start, \$current) if $attr =~ /\/\s*$/;
+
+ # Relaxed "script" or "style"
+ if ($start eq 'script' || $start eq 'style') {
+ if ($xml =~ /\G(.*?)<\s*\/\s*$start\s*>/gcsi) {
+ $self->_raw($1, \$current);
+ $self->_end($start, \$current);
+ }
+ }
}
}
@@ -1036,6 +1046,13 @@
# Append
push @$$current, ['pi', $pi];
+}
+
+sub _raw {
+ my ($self, $raw, $current) = @_;
+
+ # Append
+ push @$$current, ['raw', $raw];
}
sub _render {
@@ -1051,6 +1068,9 @@
return $escaped;
}
+ # Raw text
+ return $tree->[1] if $e eq 'raw';
+
# DOCTYPE
return "<!DOCTYPE" . $tree->[1] . ">" if $e eq 'doctype';
@@ -1127,7 +1147,7 @@
my $t = $$current->[1];
# "<li>"
- if ($t eq 'li' && $start eq 'li') { $self->_end('li', $current) }
+ if ($start eq 'li') { $self->_close($current, qr/^(li)$/, 'ul') }
# "<p>"
elsif ($t eq 'p' && $start =~ $HTML_PARAGRAPH_RE) {
@@ -1149,19 +1169,21 @@
}
# "<colgroup>"
- elsif ($start eq 'colgroup') { $self->_close_table($current) }
+ elsif ($start eq 'colgroup') { $self->_close($current) }
# "<thead>"
- elsif ($start eq 'thead') { $self->_close_table($current) }
+ elsif ($start eq 'thead') { $self->_close($current) }
# "<tbody>"
- elsif ($start eq 'tbody') { $self->_close_table($current) }
+ elsif ($start eq 'tbody') { $self->_close($current) }
# "<tfoot>"
- elsif ($start eq 'tfoot') { $self->_close_table($current) }
+ elsif ($start eq 'tfoot') { $self->_close($current) }
# "<tr>"
- elsif ($t eq 'tr' && $start eq 'tr') { $self->_end('tr', $current) }
+ elsif (($t eq 'tr' || $t eq 'td') && $start eq 'tr') {
+ $self->_end('tr', $current);
+ }
# "<th>" and "<td>"
elsif (($t eq 'th' || $t eq 'td') && ($start eq 'th' || $start eq 'td')) {
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojo/Home.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojo/Home.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojo/Home.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojo/Home.pm Fri Mar 18 22:58:40 2011
@@ -51,7 +51,7 @@
# Turn into absolute path
$self->{_parts} =
- [File::Spec->splitdir(abs_path(File::Spec->catdir(@home)))];
+ [File::Spec->splitdir(abs_path(File::Spec->catdir(@home) || '.'))];
}
}
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojo/IOLoop.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojo/IOLoop.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojo/IOLoop.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojo/IOLoop.pm Fri Mar 18 22:58:40 2011
@@ -115,23 +115,31 @@
EOF
# DNS server (default to Google Public DNS)
-our $DNS_SERVER = '8.8.8.8';
+my $DNS_SERVERS = ['8.8.8.8', '8.8.4.4'];
# Try to detect DNS server
if (-r '/etc/resolv.conf') {
my $file = IO::File->new;
$file->open('< /etc/resolv.conf');
+ my @servers;
for my $line (<$file>) {
if ($line =~ /^nameserver\s+(\S+)$/) {
# New DNS server
- $DNS_SERVER = $1;
+ push @servers, $1;
# Debug
- warn qq/DETECTED DNS SERVER ($DNS_SERVER)\n/ if DEBUG;
+ warn qq/DETECTED DNS SERVER ($1)\n/ if DEBUG;
}
}
-}
+ unshift @$DNS_SERVERS, @servers;
+}
+
+# User defined DNS server
+unshift @$DNS_SERVERS, $ENV{MOJO_DNS_SERVER} if $ENV{MOJO_DNS_SERVER};
+
+# Always start with first DNS server
+my $CURRENT_DNS_SERVER = 0;
# DNS record types
my $DNS_TYPES = {
@@ -149,7 +157,6 @@
our $LOCALHOST = '127.0.0.1';
has [qw/accept_timeout connect_timeout dns_timeout/] => 3;
-has dns_server => sub { $ENV{MOJO_DNS_SERVER} || $DNS_SERVER };
has max_accepts => 0;
has max_connections => 1000;
has [qw/on_lock on_unlock/] => sub {
@@ -250,6 +257,27 @@
return $c->{timeout};
}
+sub dns_servers {
+ my $self = shift;
+
+ # Singleton
+ $self = $self->singleton unless ref $self;
+
+ # New servers
+ if (@_) {
+ @$DNS_SERVERS = @_;
+ $CURRENT_DNS_SERVER = 0;
+ return $self;
+ }
+
+ # List all
+ return @$DNS_SERVERS if wantarray;
+
+ # Current server
+ $CURRENT_DNS_SERVER = 0 unless $DNS_SERVERS->[$CURRENT_DNS_SERVER];
+ return $DNS_SERVERS->[$CURRENT_DNS_SERVER];
+}
+
sub drop {
my ($self, $id) = @_;
@@ -452,20 +480,20 @@
$self->resolve(
$name, 'A',
sub {
- my ($self, $results) = @_;
+ my ($self, $records) = @_;
# Success
- my $result = first { $_->[0] eq 'A' } @$results;
+ my $result = first { $_->[0] eq 'A' } @$records;
return $self->$cb($result->[1]) if $result;
# IPv6
$self->resolve(
$name, 'AAAA',
sub {
- my ($self, $results) = @_;
+ my ($self, $records) = @_;
# Success
- my $result = first { $_->[0] eq 'AAAA' } @$results;
+ my $result = first { $_->[0] eq 'AAAA' } @$records;
return $self->$cb($result->[1]) if $result;
# Pass through
@@ -632,7 +660,7 @@
my $t = $DNS_TYPES->{$type};
# Server
- my $server = $self->dns_server;
+ my $server = $self->dns_servers;
# No lookup required or record type not supported
if (!$server || !$t || ($t ne $DNS_TYPES->{PTR} && ($ipv4 || $ipv6))) {
@@ -691,6 +719,9 @@
# Debug
warn "FAILED $type $name ($server)\n" if DEBUG;
+ # Next server
+ $CURRENT_DNS_SERVER++;
+
$self->drop($timer) if $timer;
$self->$cb([]);
},
@@ -751,6 +782,9 @@
# Debug
warn "RESOLVE TIMEOUT ($server)\n" if DEBUG;
+
+ # Next server
+ $CURRENT_DNS_SERVER++;
# Abort
$self->drop($id);
@@ -1798,15 +1832,6 @@
Maximum time in seconds a conenction can take to be connected before being
dropped, defaults to C<3>.
-=head2 C<dns_server>
-
- my $server = $loop->dns_server;
- $loop = $loop->dns_server('8.8.8.8');
-
-IP address of C<DNS> server to use for non-blocking lookups, defaults to the
-value of C<MOJO_DNS_SERVER>, auto detection or C<8.8.8.8>.
-Note that this attribute is EXPERIMENTAL and might change without warning!
-
=head2 C<dns_timeout>
my $timeout = $loop->dns_timeout;
@@ -1957,6 +1982,17 @@
Maximum amount of time in seconds a connection can be inactive before being
dropped.
+
+=head2 C<dns_servers>
+
+ my @all = Mojo::IOLoop->dns_servers;
+ my @all = $loop->dns_servers;
+ my $current = $loop->dns_servers;
+ $loop = $loop->dns_servers('8.8.8.8', '8.8.4.4');
+
+IP addresses of C<DNS> servers used for non-blocking lookups, defaults to the
+value of C<MOJO_DNS_SERVER>, auto detection, C<8.8.8.8> or C<8.8.4.4>.
+Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<drop>
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojolicious.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojolicious.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojolicious.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojolicious.pm Fri Mar 18 22:58:40 2011
@@ -28,17 +28,8 @@
has static => sub { Mojolicious::Static->new };
has types => sub { Mojolicious::Types->new };
-# DEPRECATED in Hot Beverage!
-*session = sub {
- warn <<EOF;
-Mojolicious->session is DEPRECATED in favor of Mojolicious->sessions!!!
-But you most likely meant to use Mojolicious::Controller->session anyway.
-EOF
- shift->sessions(@_);
-};
-
our $CODENAME = 'Smiling Cat Face With Heart-Shaped Eyes';
-our $VERSION = '1.13';
+our $VERSION = '1.15';
# "These old doomsday devices are dangerously unstable.
# I'll rest easier not knowing where they are."
@@ -132,7 +123,7 @@
$self->plugin('powered_by');
# Reduced log output outside of development mode
- $self->log->level('error') unless $mode eq 'development';
+ $self->log->level('info') unless $mode eq 'development';
# Run mode
$mode = $mode . '_mode';
@@ -286,6 +277,15 @@
# This will run for each request
sub process { shift->dispatch(@_) }
+
+# DEPRECATED in Hot Beverage!
+sub session {
+ warn <<EOF;
+Mojolicious->session is DEPRECATED in favor of Mojolicious->sessions!!!
+But you most likely meant to use Mojolicious::Controller->session anyway.
+EOF
+ shift->sessions(@_);
+}
# Start command system
sub start {
@@ -699,7 +699,7 @@
=head2 C<helper>
- $app->helper(foo => sub { ... });
+ $app->helper(foo => sub {...});
Add a new helper that will be available as a method of the controller object
and the application object, as well as a function in C<ep> templates.
@@ -715,7 +715,7 @@
=head2 C<hook>
- $app->hook(after_dispatch => sub { ... });
+ $app->hook(after_dispatch => sub {...});
Extend L<Mojolicious> by adding hooks to named events.
@@ -1026,6 +1026,8 @@
Mons Anderson
+Moritz Lenz
+
Oleg Zhelo
Pascal Gaudette
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Command/Inflate.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Command/Inflate.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Command/Inflate.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Command/Inflate.pm Fri Mar 18 22:58:40 2011
@@ -69,7 +69,8 @@
=head1 DESCRIPTION
-L<Mojolicious::Command::Inflate> prints all your application routes.
+L<Mojolicious::Command::Inflate> turns all your embedded templates into real
+ones.
=head1 ATTRIBUTES
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Controller.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Controller.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Controller.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Controller.pm Fri Mar 18 22:58:40 2011
@@ -39,32 +39,32 @@
my $STASH_RE = join '|', @RESERVED;
$STASH_RE = qr/^(?:$STASH_RE)$/;
+# "Is all the work done by the children?
+# No, not the whipping."
+sub AUTOLOAD {
+ my $self = shift;
+
+ # Method
+ my ($package, $method) = our $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
+
+ # Helper
+ Carp::croak(qq/Can't locate object method "$method" via "$package"/)
+ unless my $helper = $self->app->renderer->helpers->{$method};
+
+ # Run
+ return $self->$helper(@_);
+}
+
+sub DESTROY { }
+
# DEPRECATED in Smiling Cat Face With Heart-Shaped Eyes!
-*client = sub {
+sub client {
warn <<EOF;
Mojolicious::Controller->client is DEPRECATED in favor of
Mojolicious::Controller->ua!!!
EOF
return shift->app->client;
-};
-
-# "Is all the work done by the children?
-# No, not the whipping."
-sub AUTOLOAD {
- my $self = shift;
-
- # Method
- my ($package, $method) = our $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
-
- # Helper
- Carp::croak(qq/Can't locate object method "$method" via "$package"/)
- unless my $helper = $self->app->renderer->helpers->{$method};
-
- # Run
- return $self->$helper(@_);
-}
-
-sub DESTROY { }
+}
# "For the last time, I don't like lilacs!
# Your first wife was the one who liked lilacs!
@@ -1297,7 +1297,13 @@
my @foo = $c->param('foo');
$c = $c->param(foo => 'ba;r');
-Request parameters and routes captures.
+Access GET/POST parameters and route captures.
+
+ # Only GET parameters
+ my $foo = $c->req->url->query->param('foo');
+
+ # Only GET and POST parameters
+ my $foo = $c->req->param('foo');
=head2 C<redirect_to>
@@ -1477,13 +1483,14 @@
A L<Mojo::UserAgent> prepared for the current environment.
+ # Blocking
my $tx = $c->ua->get('http://mojolicio.us');
-
- $c->ua->post_form('http://kraih.com/login' => {user => 'mojo'});
-
+ my $tx = $c->ua->post_form('http://kraih.com/login' => {user => 'mojo'});
+
+ # Non-blocking
$c->ua->get('http://mojolicio.us' => sub {
- my $ua = shift;
- $c->render_data($ua->res->body);
+ my $tx = pop;
+ $c->render_data($tx->res->body);
});
=head2 C<url_for>
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/Config.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/Config.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/Config.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/Config.pm Fri Mar 18 22:58:40 2011
@@ -26,7 +26,7 @@
my ($self, $content, $file, $conf, $app) = @_;
# Run Perl code
- no warnings 'redefine';
+ no warnings;
die qq/Couldn't parse config file "$file": $@/
unless my $config = eval "sub app { \$app }; $content";
die qq/Config file "$file" did not return a hashref.\n/
@@ -96,6 +96,15 @@
# Merge
$config = {%{$conf->{default}}, %$config} if $conf->{default};
+ # Add "config" helper
+ $app->helper(
+ config => sub {
+ my $self = shift;
+ return $config unless @_;
+ return $config->{$_[0]};
+ }
+ );
+
# Default
$app->defaults(($conf->{stash_key} || 'config') => $config);
@@ -171,6 +180,15 @@
Configuration stash key.
+=head1 HELPERS
+
+=head2 C<config>
+
+ <%= config 'something' %>
+ <%= config->{something} %>
+
+Access config values.
+
=head1 METHODS
L<Mojolicious::Plugin::Config> inherits all methods from
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/DefaultHelpers.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/DefaultHelpers.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/DefaultHelpers.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/DefaultHelpers.pm Fri Mar 18 22:58:40 2011
@@ -224,7 +224,7 @@
<%= param 'foo' %>
-Access request parameters and routes captures.
+Access GET/POST parameters and route captures.
=head2 C<session>
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/JsonConfig.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/JsonConfig.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/JsonConfig.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Plugin/JsonConfig.pm Fri Mar 18 22:58:40 2011
@@ -115,6 +115,11 @@
Template options.
+=head1 HELPERS
+
+L<Mojolicious::Plugin::JsonConfig> defines the same helpers as
+L<Mojolicious::Plugin::Config>.
+
=head1 METHODS
L<Mojolicious::Plugin::JsonConfig> inherits all methods from
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Renderer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Renderer.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Renderer.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Renderer.pm Fri Mar 18 22:58:40 2011
@@ -428,14 +428,14 @@
=head2 C<handlers>
my $handlers = $renderer->handlers;
- $renderer = $renderer->handlers({epl => sub { ... }});
+ $renderer = $renderer->handlers({epl => sub {...}});
Registered handlers.
=head2 C<helpers>
my $helpers = $renderer->helpers;
- $renderer = $renderer->helpers({url_for => sub { ... }});
+ $renderer = $renderer->helpers({url_for => sub {...}});
Registered helpers.
@@ -466,14 +466,14 @@
=head2 C<add_handler>
- $renderer = $renderer->add_handler(epl => sub { ... });
+ $renderer = $renderer->add_handler(epl => sub {...});
Add a new handler to the renderer.
See L<Mojolicious::Plugin::EpRenderer> for a sample renderer.
=head2 C<add_helper>
- $renderer = $renderer->add_helper(url_for => sub { ... });
+ $renderer = $renderer->add_helper(url_for => sub {...});
Add a new helper to the renderer.
See L<Mojolicious::Plugin::EpRenderer> for sample helpers.
Modified: branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Routes.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Routes.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Routes.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Mojolicious/Routes.pm Fri Mar 18 22:58:40 2011
@@ -796,7 +796,7 @@
=head2 C<dictionary>
my $dictionary = $r->dictionary;
- $r = $r->dictionary({foo => sub { ... }});
+ $r = $r->dictionary({foo => sub {...}});
Contains all available conditions for this route.
@@ -847,7 +847,7 @@
=head2 C<shortcuts>
my $shortcuts = $r->shortcuts;
- $r = $r->shortcuts({foo => sub { ... }});
+ $r = $r->shortcuts({foo => sub {...}});
Contains all additional route shortcuts available for this route.
@@ -871,13 +871,13 @@
=head2 C<add_condition>
- $r = $r->add_condition(foo => sub { ... });
+ $r = $r->add_condition(foo => sub {...});
Add a new condition for this route.
=head2 C<add_shortcut>
- $r = $r->add_shortcut(foo => sub { ... });
+ $r = $r->add_shortcut(foo => sub {...});
Add a new shortcut for this route.
Modified: branches/upstream/libmojolicious-perl/current/lib/Test/Mojo.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/lib/Test/Mojo.pm?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/lib/Test/Mojo.pm (original)
+++ branches/upstream/libmojolicious-perl/current/lib/Test/Mojo.pm Fri Mar 18 22:58:40 2011
@@ -13,16 +13,16 @@
has max_redirects => 0;
has 'tx';
+# Silent or loud tests
+$ENV{MOJO_LOG_LEVEL} ||= $ENV{HARNESS_IS_VERBOSE} ? 'debug' : 'fatal';
+
# DEPRECATED in Smiling Cat Face With Heart-Shaped Eyes!
-*client = sub {
+sub client {
warn <<EOF;
Test::Mojo->client is DEPRECATED in favor of Test::Mojo->ua!!!
EOF
return shift->ua;
-};
-
-# Silent or loud tests
-$ENV{MOJO_LOG_LEVEL} ||= $ENV{HARNESS_IS_VERBOSE} ? 'debug' : 'fatal';
+}
# "Ooh, a graduate student huh?
# How come you guys can go to the moon but can't make my shoes smell good?"
Modified: branches/upstream/libmojolicious-perl/current/t/mojo/dom.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/t/mojo/dom.t?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/t/mojo/dom.t (original)
+++ branches/upstream/libmojolicious-perl/current/t/mojo/dom.t Fri Mar 18 22:58:40 2011
@@ -5,7 +5,7 @@
use utf8;
-use Test::More tests => 411;
+use Test::More tests => 442;
# "Homer gave me a kidney: it wasn't his, I didn't need it,
# and it came postage due- but I appreciated the gesture!"
@@ -1129,3 +1129,142 @@
is $dom->find('table > tr > td')->[1]->text, 'B', 'right text';
is $dom->find('table > tr > td')->[2]->text, "C\n ", 'right text';
is $dom->find('table > tr > td')->[3]->text, "D\n", 'right text';
+
+# Real world table
+$dom->parse(<<EOF);
+<html>
+ <head>
+ <title>Real World!</title>
+ <body>
+ <p>Just a test
+ <table class=RealWorld>
+ <thead>
+ <tr>
+ <th class=one>One
+ <th class=two>Two
+ <th class=three>Three
+ <th class=four>Four
+ <tbody>
+ <tr>
+ <td class=alpha>Alpha
+ <td class=beta>Beta
+ <td class=gamma><a href="#gamma">Gamma</a>
+ <td class=delta>Delta
+ <tr>
+ <td class=alpha>Alpha Two
+ <td class=beta>Beta Two
+ <td class=gamma><a href="#gamma-two">Gamma Two</a>
+ <td class=delta>Delta Two
+ </table>
+EOF
+is $dom->find('html > head > title')->[0]->text, 'Real World!', 'right text';
+is $dom->find('html > body > p')->[0]->text, "Just a test\n ",
+ 'right text';
+is $dom->find('p')->[0]->text, "Just a test\n ", 'right text';
+is $dom->find('thead > tr > .three')->[0]->text, "Three\n ",
+ 'right text';
+is $dom->find('thead > tr > .four')->[0]->text, "Four\n ", 'right text';
+is $dom->find('tbody > tr > .beta')->[0]->text, "Beta\n ",
+ 'right text';
+is $dom->find('tbody > tr > .gamma')->[0]->text, '', 'no text';
+is $dom->find('tbody > tr > .gamma > a')->[0]->text, 'Gamma', 'right text';
+is $dom->find('tbody > tr > .alpha')->[1]->text, "Alpha Two\n ",
+ 'right text';
+is $dom->find('tbody > tr > .gamma > a')->[1]->text, 'Gamma Two',
+ 'right text';
+
+# Real world list
+$dom->parse(<<EOF);
+<html>
+ <head>
+ <title>Real World!</title>
+ <body>
+ <ul>
+ <li>
+ Test
+ <br>
+ 123
+ <p>
+
+ <li>
+ Test
+ <br>
+ 321
+ <p>
+ </ul>
+EOF
+is $dom->find('html > head > title')->[0]->text, 'Real World!', 'right text';
+is $dom->find('body > ul > li')->[0]->text,
+ "\n Test\n \n 123\n ",
+ 'right text';
+is $dom->find('body > ul > li > p')->[0]->text, '', 'no text';
+is $dom->find('body > ul > li')->[1]->text,
+ "\n Test\n \n 321\n ",
+ 'right text';
+is $dom->find('body > ul > li > p')->[1]->text, '', 'no text';
+
+# Real world JavaScript and CSS
+$dom->parse(<<EOF);
+<html>
+ <head>
+ <style test=works>#style { foo: style('<test>'); }</style>
+ <script>
+ if (a < b) {
+ alert('<123>');
+ }
+ </script>
+ < sCriPt two="23" >if (b > c) { alert('&<ohoh>') }< / scRiPt >
+ <body>Foo!</body>
+EOF
+is $dom->find('html > body')->[0]->text, 'Foo!', 'right text';
+is $dom->find('html > head > style')->[0]->text,
+ "#style { foo: style('<test>'); }", 'right text';
+is $dom->find('html > head > script')->[0]->text,
+ "\n if (a < b) {\n alert('<123>');\n }\n ",
+ 'right text';
+is $dom->find('html > head > script')->[1]->text,
+ "if (b > c) { alert('&<ohoh>') }", 'right text';
+
+# More real world JavaScript
+$dom->parse(<<EOF);
+<!doctype html><html>
+ <head>
+ <title>Foo</title>
+ <script type="text/javascript" src="/js/one.js"></script>
+ <script type="text/javascript" src="/js/two.js"></script>
+ <script type="text/javascript" src="/js/three.js"></script>
+ </head>
+ <body>Bar</body>
+</html>
+EOF
+is $dom->at('title')->text, 'Foo', 'right text';
+is $dom->find('html > head > script')->[0]->attrs('src'), '/js/one.js',
+ 'right attribute';
+is $dom->find('html > head > script')->[1]->attrs('src'), '/js/two.js',
+ 'right attribute';
+is $dom->find('html > head > script')->[2]->attrs('src'), '/js/three.js',
+ 'right attribute';
+is $dom->find('html > head > script')->[2]->text, '', 'no text';
+is $dom->at('html > body')->text, 'Bar', 'right text';
+
+# Even more real world JavaScript
+$dom->parse(<<EOF);
+<!doctype html><html>
+ <head>
+ <title>Foo</title>
+ <script type="text/javascript" src="/js/one.js"></script>
+ <script type="text/javascript" src="/js/two.js"></script>
+ <script type="text/javascript" src="/js/three.js">
+ </head>
+ <body>Bar</body>
+</html>
+EOF
+is $dom->at('title')->text, 'Foo', 'right text';
+is $dom->find('html > head > script')->[0]->attrs('src'), '/js/one.js',
+ 'right attribute';
+is $dom->find('html > head > script')->[1]->attrs('src'), '/js/two.js',
+ 'right attribute';
+is $dom->find('html > head > script')->[2]->attrs('src'), '/js/three.js',
+ 'right attribute';
+is $dom->find('html > head > script')->[2]->text, '', 'no text';
+is $dom->at('html > body')->text, 'Bar', 'right text';
Modified: branches/upstream/libmojolicious-perl/current/t/mojo/home.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/t/mojo/home.t?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/t/mojo/home.t (original)
+++ branches/upstream/libmojolicious-perl/current/t/mojo/home.t Fri Mar 18 22:58:40 2011
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More tests => 5;
use Cwd qw/cwd realpath/;
use File::Spec;
@@ -29,6 +29,13 @@
is_deeply [split /\\|\//, $target], [split /\\|\//, $home],
'right path detected';
+# Specific class detection
+$INC{'MyClass.pm'} = 'MyClass.pm';
+$home = Mojo::Home->new->detect('MyClass');
+is_deeply [split /\\|\//, File::Spec->canonpath($home->to_string)],
+ [split /\\|\//, File::Spec->canonpath(cwd())],
+ 'right path detected';
+
# FindBin detection
$home = Mojo::Home->new->app_class(undef)->detect;
is_deeply [split /\\|\//,
Modified: branches/upstream/libmojolicious-perl/current/t/mojo/ioloop_online.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/t/mojo/ioloop_online.t?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/t/mojo/ioloop_online.t (original)
+++ branches/upstream/libmojolicious-perl/current/t/mojo/ioloop_online.t Fri Mar 18 22:58:40 2011
@@ -9,7 +9,7 @@
use Test::More;
plan skip_all => 'set TEST_ONLINE to enable this test (developer only!)'
unless $ENV{TEST_ONLINE};
-plan tests => 12;
+plan tests => 18;
use_ok 'Mojo::IOLoop';
@@ -19,7 +19,7 @@
# "Your guilty consciences may make you vote Democratic, but secretly you all
# yearn for a Republican president to lower taxes, brutalize criminals, and
# rule you like a king!"
-my $loop = Mojo::IOLoop->new;
+my $loop = Mojo::IOLoop->singleton;
# Resolve all record
my %types;
@@ -155,3 +155,23 @@
}
)->start;
ok $found, 'found IPv6 PTR record';
+
+# Invalid DNS server
+ok scalar Mojo::IOLoop->dns_servers, 'got a dns server';
+Mojo::IOLoop->dns_servers('192.0.2.1', Mojo::IOLoop->dns_servers);
+is Mojo::IOLoop->dns_servers, '192.0.2.1', 'new invalid dns server';
+Mojo::IOLoop->lookup('google.com', sub { Mojo::IOLoop->stop })->start;
+my $fallback = Mojo::IOLoop->dns_servers;
+isnt $fallback, '192.0.2.1', 'valid dns server';
+$result = undef;
+Mojo::IOLoop->lookup(
+ 'google.com',
+ sub {
+ my ($self, $address) = @_;
+ $result = $address;
+ $self->stop;
+ }
+)->start;
+ok $result, 'got an address';
+is scalar $loop->dns_servers, $fallback, 'still the same dns server';
+isnt $fallback, '192.0.2.1', 'still valid dns server';
Modified: branches/upstream/libmojolicious-perl/current/t/mojolicious/json_config_lite_app.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojolicious-perl/current/t/mojolicious/json_config_lite_app.t?rev=71658&op=diff
==============================================================================
--- branches/upstream/libmojolicious-perl/current/t/mojolicious/json_config_lite_app.t (original)
+++ branches/upstream/libmojolicious-perl/current/t/mojolicious/json_config_lite_app.t Fri Mar 18 22:58:40 2011
@@ -8,7 +8,7 @@
# Disable IPv6, epoll and kqueue
BEGIN { $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
-use Test::More tests => 8;
+use Test::More tests => 16;
# "Oh, I always feared he might run off like this.
# Why, why, why didn't I break his legs?"
@@ -21,6 +21,12 @@
is $config->{foo}, 'bar', 'right value';
is $config->{hello}, 'there', 'right value';
is $config->{utf}, 'утф', 'right value';
+is app->config->{foo}, 'bar', 'right value';
+is app->config->{hello}, 'there', 'right value';
+is app->config->{utf}, 'утф', 'right value';
+is app->config('foo'), 'bar', 'right value';
+is app->config('hello'), 'there', 'right value';
+is app->config('utf'), 'утф', 'right value';
# GET /
get '/' => 'index';
@@ -28,16 +34,18 @@
my $t = Test::Mojo->new;
# GET /
-$t->get_ok('/')->status_is(200)->content_like(qr/bar/);
+$t->get_ok('/')->status_is(200)->content_is("barbarbar\n");
# No config file, default only
$config =
plugin json_config => {file => 'nonexisted', default => {foo => 'qux'}};
is $config->{foo}, 'qux', 'right value';
+is app->config->{foo}, 'qux', 'right value';
+is app->config('foo'), 'qux', 'right value';
# No config file, no default
ok !(eval { plugin json_config => {file => 'nonexisted'} }), 'no config file';
__DATA__
@@ index.html.ep
-<%= $config->{foo} %>
+<%= $config->{foo} %><%= config->{foo} %><%= config 'foo' %>
More information about the Pkg-perl-cvs-commits
mailing list