package Serengeti::Context; use strict; use warnings; use File::Basename qw(); use File::Spec; use JavaScript; use List::Util qw(first); use Module::Load qw(); use Scalar::Util qw(blessed); use Regexp::Common qw(URI); use Serengeti; use Serengeti::NotificationCenter; use Serengeti::Notifications; use Serengeti::Util qw(trim); use accessors::ro qw(js_ctx search_paths backend callbacks session windows); { my $JSRuntime; sub shared_js_runtime { return $JSRuntime if $JSRuntime; $JSRuntime = JavaScript::Runtime->new(); return $JSRuntime; } } sub new { my ($pkg, $args) = @_; my $ctx = shared_js_runtime->create_context(); my $backend = $args->{backend} || $Serengeti::DefaultBackend; Module::Load::load $backend; my $self = bless { js_ctx => $ctx, search_paths => ["."], backend => $backend->new, callbacks => {}, session => undef, }, $pkg; $self->_setup_jsapi(); return $self; } sub register_callback { my ($self, $name, $callback) = @_; $self->callbacks->{$name} = $callback; } sub _setup_jsapi { my $self = shift; my $ctx = $self->js_ctx; my $common = { include => sub { my $path = shift; # We can actually include remote files which contains # stuff that the website needs if ($path =~ $RE{URI}{HTTP}) { my $response = $self->backend->get($path); if ($response->is_success) { $ctx->eval($response->decoded_content); if ($@) { warn $@; } } return; } $self->load($path); }, gimme => sub { my $name = pop; # $self->session->log_action("requested data", @_); die "Missing data request name" unless defined $name; # Calls a registered perl function to retrieve stuff like # passwords which might not want to be sent as args my $callback = $self->callbacks->{$name}; die "Missing callback for '${name}'" unless $callback; return $callback->(@_); }, get => sub { $self->backend->get(@_); }, post => sub { $self->backend->post(@_); }, head => sub { $self->backend->get(@_); }, log => sub { # This should tell the session object to log an entry print STDERR join("", @_), "\n"; }, match => \&match, }; $self->backend->setup_document_jsapi($self->js_ctx); $self->backend->setup_window_jsapi($self->js_ctx); $ctx->bind_object('$Browser' => $common); # Listen to when we get new documents Serengeti::NotificationCenter->add_observer( $self, selector => "document_changed", for => DOCUMENT_CHANGED_NOTIFICATION, from => $self->backend, ); Serengeti::NotificationCenter->add_observer( $self, selector => "session_changed", for => NEW_SESSION_NOTIFICATION, ); Serengeti::NotificationCenter->add_observer( $self, selector => "log_session_event", for => SESSION_EVENT_NOTIFICATION, from => $self->backend, ); 1; } sub DESTROY { my $self = shift; Serengeti::NotificationCenter->remove_observer($self); } sub load { my ($self, $file) = @_; my $path; my @inc = @{$self->search_paths}; for my $dir (@inc) { my $lp = File::Spec->catfile($dir, $file); $path = $lp, last if -e $lp; } die "Can't find file: $file" unless $path; my $dirname = File::Basename::dirname($path); # Temporary add the file's basename to the list of directories to search. my $inc = $self->search_paths; my @new_inc = @$inc; push @new_inc, $dirname unless first { $_ eq $dirname } @new_inc; local $self->{search_paths} = \@new_inc; $self->js_ctx->eval_file($path); die "$@" if $@; } sub has_action { my ($self, $action) = @_; return $self->js_ctx->can($action); } sub invoke_action { my ($self, $action, $args, $options) = @_; $args = {} unless ref $args eq "HASH"; $options = {} unless ref $args eq "HASH"; return $self->js_ctx->call($action, $args, $options); } sub eval { my ($self, $source, $filename, $lineno) = @_; return $self->js_ctx->eval($source, $filename, $lineno); } sub session_changed { my ($self, $sender, $notification, $data) = @_; $self->{session} = $data; } sub document_changed { my ($self) = @_; $self->js_ctx->unbind_value("document"); $self->js_ctx->bind_object(document => $self->backend->current_document); 1; } sub log_session_event { my ($self, $sender, $notification, $data) = @_; if ($self->session) { my ($action, $event_args) = @{$data}{qw(event data)}; $event_args = [] unless ref $event_args eq "ARRAY"; $self->session->log_event($action, @$event_args); } } sub match { my $self = shift; my $content; if (ref $_[0] eq "Regexp") { # Default to document.body.innerHTML; $content = $self->backend->current_document->get_body->as_HTML; } else { $content = shift; if (blessed $content && $content->isa("HTML::Element")) { $content = $content->as_HTML; } } my $re = shift; $re = qr/$re/ unless ref $re eq "Regexp"; my $options = shift; $options = {} unless ref $options eq "HASH"; # Perform matching my $matches = 0; my $session = $self->session; my $stash = $session ? $session->stash : undef; my @set; if (defined $options->{set} && $stash) { @set = map trim, split /\s*,\s*/, $options->{set}; delete @{$stash}{@set} if $stash; } my %set; while (my @matches = ($content =~ $re)) { $content =~ s/$re//; $matches++; for my $key (@set) { my $v = shift @matches; if (ref $stash->{$key} eq "ARRAY") { push @{$stash->{$key}}, $v; } elsif (exists $stash->{$key}) { $stash->{$key} = [delete $stash->{$key}, $v]; } else { $stash->{$key} = $v; } } } if (exists $options->{strict}) { my $expect_matches = $options->{strict} || 0; if ($matches != $expect_matches) { die "Match matches ", $matches, " time(s) instead of required ", ${expect_matches}, " time(s)"; } } return $matches; } 1; __END__ =head1 NAME Serengeti::Context - Provides a space where functions and objects are executed =cut