[libweasel-perl] 02/07: * Add logging
Robert James Clay
jame at rocasa.us
Tue Aug 15 19:16:13 UTC 2017
This is an automated email from the git hooks/post-receive script.
jame-guest pushed a commit to tag v0.08
in repository libweasel-perl.
commit b267d9eb8bee65753600ae2871845658b3886d3a
Author: Erik Huelsmann <ehuels at gmail.com>
Date: Fri Aug 26 18:59:06 2016 +0200
* Add logging
---
lib/Weasel/Session.pm | 161 ++++++++++++++++++++++++++++++++++++++++++--------
t/01-logging.t | 78 ++++++++++++++++++++++++
2 files changed, 215 insertions(+), 24 deletions(-)
diff --git a/lib/Weasel/Session.pm b/lib/Weasel/Session.pm
index 83e6b8e..ad0a941 100644
--- a/lib/Weasel/Session.pm
+++ b/lib/Weasel/Session.pm
@@ -42,6 +42,7 @@ use Module::Runtime qw/ use_module /;;
use Weasel::FindExpanders qw/ expand_finder_pattern /;
use Weasel::WidgetHandlers qw| best_match_handler_class |;
+
=head1 ATTRIBUTES
=over
@@ -102,6 +103,17 @@ sub _page_builder {
return $class->new(session => $self);
}
+=item log_hook
+
+Upon instantiation can be set to log consumer; a function of 3 arguments:
+ 1. the name of the event
+ 2. the text to be logged (or a coderef to be called without arguments returning such)
+
+=cut
+
+has 'log_hook' => (is => 'ro',
+ isa => 'Maybe[CodeRef]');
+
=item page_class
Upon instantiation can be set to an alternative class name for the C<page>
@@ -139,6 +151,7 @@ has 'poll_delay' => (is => 'rw',
=back
+
=head1 METHODS
@@ -154,7 +167,8 @@ textarea elements and input elements of type text and password.
sub clear {
my ($self, $element) = @_;
- $self->driver->clear($element->_id);
+ $self->_logged(sub { $self->driver->clear($element->_id); },
+ 'clear', 'clearing input element');
}
=item click([$element])
@@ -168,7 +182,11 @@ current mouse location.
sub click {
my ($self, $element) = @_;
- $self->driver->click(($element) ? $element->_id : undef);
+ $self->_logged(
+ sub {
+ $self->driver->click(($element) ? $element->_id : undef);
+ },
+ 'click', ($element) ? 'clicking element' : 'clicking window');
}
=item find($element, $locator [, scheme => $scheme] [, %locator_args])
@@ -183,11 +201,14 @@ sub find {
my ($self, @args) = @_;
my $rv;
- $self->wait_for(
+ $self->_logged(
sub {
- my @rv = @{$self->find_all(@args)};
- return $rv = shift @rv;
- });
+ $self->wait_for(
+ sub {
+ my @rv = @{$self->find_all(@args)};
+ return $rv = shift @rv;
+ });
+ }, 'find', 'find ' . $args[1]);
return $rv;
}
@@ -206,13 +227,25 @@ sub find_all {
my ($self, $element, $pattern, %args) = @_;
my $expanded_pattern = expand_finder_pattern($pattern, \%args);
- my @rv =
- map { $self->_wrap_widget($_) }
- $self->driver->find_all($element->_id,
- $expanded_pattern,
- $args{scheme});
- print STDERR "found " . scalar(@rv) . " elements for $pattern " . (join(', ', %args)) . "\n";
- print STDERR ' - ' . ref($_) . " (" . $_->tag_name . ")\n" for (@rv);
+ my @rv = $self->_logged(
+ sub {
+ return
+ map { $self->_wrap_widget($_) }
+ $self->driver->find_all($element->_id,
+ $expanded_pattern,
+ $args{scheme});
+ },
+ 'find_all',
+ sub {
+ my ($rv) = @_;
+ return "found " . scalar(@$rv) . " elements for $pattern "
+ . (join(', ', %args)) . "\n"
+ . (join("\n",
+ map { ' - ' . ref($_)
+ . ' (' . $_->tag_name . ")" } @$rv));
+ },
+ "pattern: $pattern");
+
return wantarray ? @rv : \@rv;
}
@@ -230,7 +263,10 @@ sub get {
$url = $self->base_url . $url;
###TODO add logging warning of urls without protocol part
# which might indicate empty 'base_url' where one is assumed to be set
- $self->driver->get($url);
+ $self->_logged(
+ sub {
+ return $self->driver->get($url);
+ }, 'get', "loading URL: $url");
}
=item get_attribute($element, $attribute)
@@ -243,7 +279,10 @@ identified by C<$element>, or C<undef> if the attribute isn't defined.
sub get_attribute {
my ($self, $element, $attribute) = @_;
- return $self->driver->get_attribute($element->_id, $attribute);
+ return $self->_logged(
+ sub {
+ return $self->driver->get_attribute($element->_id, $attribute);
+ }, 'get_attribute', "element attribute '$attribute'");
}
=item get_text($element)
@@ -255,7 +294,11 @@ Returns the 'innerHTML' of the element identified by C<$element>.
sub get_text {
my ($self, $element) = @_;
- return $self->driver->get_text($element->_id);
+ return $self->_logged(
+ sub {
+ return $self->driver->get_text($element->_id);
+ },
+ 'get_text', 'element text');
}
=item is_displayed($element)
@@ -269,7 +312,11 @@ the viewport for interaction.
sub is_displayed {
my ($self, $element) = @_;
- return $self->driver->is_displayed($element->_id);
+ return $self->_logged(
+ sub {
+ return $self->driver->is_displayed($element->_id);
+ },
+ 'is_displayed', 'query is_displayed');
}
=item screenshot($fh)
@@ -285,7 +332,10 @@ Note: this version assumes pictures of type PNG will be written;
sub screenshot {
my ($self, $fh) = @_;
- $self->driver->screenshot($fh);
+ $self->_logged(
+ sub {
+ $self->driver->screenshot($fh);
+ }, 'screenshot', 'screenshot');
}
=item send_keys($element, @keys)
@@ -298,7 +348,11 @@ simulating keyboard input.
sub send_keys {
my ($self, $element, @keys) = @_;
- $self->driver->send_keys($element->_id, @keys);
+ $self->_logged(
+ sub {
+ $self->driver->send_keys($element->_id, @keys);
+ },
+ 'send_keys', 'sending keys: ' . join('', @keys));
}
=item tag_name($element)
@@ -310,7 +364,10 @@ Returns the tag name of the element identified by C<$element>.
sub tag_name {
my ($self, $element) = @_;
- return $self->driver->tag_name($element->_id);
+ return $self->_logged(sub { return $self->driver->tag_name($element->_id) },
+ 'tag_name',
+ sub { my $tag = shift; return "found tag with name $tag" },
+ 'getting tag name');
}
=item wait_for($callback, [ retry_timeout => $number,] [poll_delay => $number])
@@ -326,11 +383,67 @@ session-global settings.
sub wait_for {
my ($self, $callback, %args) = @_;
- $self->driver->wait_for($callback,
- retry_timeout => $self->retry_timeout,
- poll_delay => $self->poll_delay,
- %args);
+ $self->_logged(
+ sub {
+ $self->driver->wait_for($callback,
+ retry_timeout => $self->retry_timeout,
+ poll_delay => $self->poll_delay,
+ %args);
+ },
+ 'wait_for', 'waiting for condition');
+}
+
+
+sub _appending_wrap {
+ my ($str) = @_;
+ return sub {
+ my $rv = shift;
+ if ($rv) {
+ return "$str ($rv)";
+ }
+ else {
+ return $str;
+ }
+ }
}
+=item _logged($wrapped_fn, $event, $log_item, $log_item_pre)
+
+Invokes C<log_hook> when it's defined, before and after calling C<$wrapped_fn>
+with no arguments, with the 'pre_' and 'post_' prefixes to the event name.
+
+C<$log_item> can be a fixed string or a function of one argument returning
+the string to be logged. The argument passed into the function is the value
+returned by the C<$wrapped_fn>.
+
+In case there is no C<$log_item_pre> to be called on the 'pre_' event, C<$log_item>
+will be used instead, with no arguments.
+
+For performance reasons, the C<$log_item> and C<$log_item_pre> - when coderefs - aren't
+called; instead they are passed as-is to the C<$log_hook> for lazy evaluation.
+
+=cut
+
+sub _logged {
+ my ($self, $f, $e, $l, $lp) = @_;
+ my $hook = $self->log_hook;
+
+ return $f->() if ! defined $hook;
+
+ $lp //= $l;
+ my $pre = (ref $lp eq 'CODE') ? $lp : _appending_wrap($lp);
+ my $post = (ref $l eq 'CODE') ? $l : _appending_wrap($l);
+ $hook->("pre_$e", $pre);
+ if (wantarray) {
+ my @rv = $f->();
+ $hook->("post_$e", sub { return $l->(\@rv); });
+ return @rv;
+ }
+ else {
+ my $rv = $f->();
+ $hook->("post_$e", sub { return $l->($rv); });
+ return $rv;
+ }
+};
=item _wrap_widget($_id)
diff --git a/t/01-logging.t b/t/01-logging.t
new file mode 100644
index 0000000..061e524
--- /dev/null
+++ b/t/01-logging.t
@@ -0,0 +1,78 @@
+#!perl
+
+
+use Data::Dumper;
+use Test::More;
+
+package DummyDriver {
+ use Data::Dumper;
+ use Moose;
+ with 'Weasel::DriverRole';
+
+ sub tag_name {
+ my ($self, $tag) = @_;
+
+ return $tag->{tag};
+ }
+
+ sub find_all {
+ my @rv = (
+ { tag => 'span' },
+ { tag => 'span' },
+ );
+
+ return (wantarray) ? @rv : \@rv;
+ }
+}
+
+use Weasel;
+use Weasel::Session;
+
+my @logs;
+
+my $weasel =
+ Weasel->new(
+ default_session => 'default',
+ sessions => {
+ default => Weasel::Session->new(
+ driver => DummyDriver->new(),
+ log_hook => sub {
+ my ($event, $item) = @_;
+ $item = $item->() if ref $item eq 'CODE';
+ push @logs, [ $event, $item ];
+ },
+ ),
+ },
+ );
+
+my $session = $weasel->session;
+
+# Specifically test `find_all' due to the complex nature:
+# It can return an array ref in scalar context or an array in
+# list context -- yet the logger will receive an array ref (always)
+my @found = $session->page->find_all('span');
+my $found = $session->page->find_all('span');
+
+is(scalar(@found), 2, 'Number of tags found equals two');
+is(ref $found, 'ARRAY', 'Scalar context returns ARRAYREF');
+
+is_deeply(\@logs,
+ [['pre_find_all', 'pattern: span'],
+ ['pre_tag_name', 'getting tag name'],
+ ['post_tag_name', 'found tag with name span'],
+ ['pre_tag_name', 'getting tag name'],
+ ['post_tag_name', 'found tag with name span'],
+ ['post_find_all', 'found 2 elements for span
+ - Weasel::Element (span)
+ - Weasel::Element (span)'],
+ ['pre_find_all', 'pattern: span'],
+ ['pre_tag_name', 'getting tag name'],
+ ['post_tag_name', 'found tag with name span'],
+ ['pre_tag_name', 'getting tag name'],
+ ['post_tag_name', 'found tag with name span'],
+ ['post_find_all', 'found 2 elements for span
+ - Weasel::Element (span)
+ - Weasel::Element (span)']
+ ], 'Compare log output');
+
+done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libweasel-perl.git
More information about the Pkg-perl-cvs-commits
mailing list