Jifty::Test::WWW::Mechanize - Subclass of L<Test::WWW::Mechanize> with

   my $mon = $mech->moniker_for('MyApp::Action::UpdateInfo');

    $mech->fill_in_action_ok($mech->moniker_for('MyApp::Action::UpdateInfo'),
                             owner_id => 'someone');
    $mech->submit_html_ok();

    is($mech->action_field_value($mech->moniker_for("MyApp::Action::UpdateInfo"),
                                 'owner_id'),
       'someone',
       "Owner was reassigned properly to owner 'someone'");

use strict;
use warnings;

package Jifty::Test::WWW::Mechanize;
use base qw/Test::WWW::Mechanize/;

delete $ENV{'http_proxy'}; # Otherwise Test::WWW::Mechanize tries to go through your HTTP proxy

use Test::More;
use Jifty::YAML;
use HTML::Lint;
use Test::HTML::Lint qw();
use HTTP::Cookies;
use HTML::TreeBuilder::XPath;
use List::Util qw(first);
use Plack::Test;
use Carp;

# XXX TODO: We're leaving out FLUFF errors because it complains about non-standard
# attributes such as "autocomplete" on <form> elements.  There should be a better
# way to fix this.
my $lint = HTML::Lint->new( only_types => [HTML::Lint::Error::STRUCTURE,
                                           HTML::Lint::Error::HELPER] );

my $plack_server_pid;

sub new {
    my ($class, @args) = @_;

    push @args, app => Jifty->handler->psgi_app
        if $class->isa('Test::WWW::Mechanize::PSGI');

    my $self = $class->SUPER::new(@args);
    $self->cookie_jar(HTTP::Cookies->new);

    return $self;
}

sub _modify_request {
    my ($self, $req) = @_;
    $req->header( 'Accept-Encoding', 'identity' )
        unless $req->header( 'Accept-Encoding' );
    return $self->SUPER::_modify_request($req);
}

sub moniker_for {
  my $self = shift;
  my $action = Jifty->api->qualify(shift);
  my %args = @_;

  for my $f ($self->forms) {
  INPUT: 
    for my $input ($f->inputs) {
      if ($input->type eq "hidden" and $input->name =~ /^J:A-(?:\d+-)?(.*)/ and $input->value eq $action) {

        my $moniker = $1;

        for my $id (keys %args) {
          my $idfield = $f->find_input("J:A:F:F-$id-$moniker")
                     || $f->find_input("J:A:F-$id-$moniker");
          next INPUT unless $idfield and $idfield->value eq $args{$id};
        }

        return $1;
      }
    }
    # if we've gotten to this point, there were no hidden fields with a moniker,
    # possibly a form with only its continuation-marking hidden field.
    # Fall back to a submit field with similar attributes.
    for my $input ($f->inputs) {
        my $name = $input->name || '';

        next unless $input->type eq "submit";
        next unless $name =~ /\Q$action\E/;
        my ($moniker) = $name =~ /J:ACTIONS=([^|]+)\|/
            or next;
        return $moniker;
    }
  }
  return undef;
}

sub fill_in_action {
    my $self = shift;
    my $moniker = shift;
    my %args = @_;

    my $action_form = $self->action_form($moniker, keys %args);
    return unless $action_form;

    for my $arg (keys %args) {
        my $input = $action_form->find_input("J:A:F-$arg-$moniker");
        unless ($input) {
            return;
        } 

        # not $input->value($args{$arg}), because it doesn't handle arrayref
        $action_form->param( $input->name, $args{$arg} );
    } 

    return $action_form;
}

sub fill_in_action_ok {
    my $self = shift;
    my $moniker = shift;

    my $ret = $self->fill_in_action($moniker, @_);
    my $Test = Test::Builder->new;
    $Test->ok($ret, "Filled in action $moniker");
} 

sub action_form {
    my $self = shift;
    my $moniker = shift;
    my @fields = @_;
    Carp::confess("No moniker") unless $moniker;

    my $i;
    for my $form ($self->forms) {
        no warnings 'uninitialized';

        $i++;
        next unless first {   $_->name =~ /J:A-(?:\d+-)?$moniker/
                           && $_->type eq "hidden" }
                        $form->inputs;
        next if grep {not $form->find_input("J:A:F-$_-$moniker")} @fields;

        $self->form_number($i); #select it, for $mech->submit etc
        return $form;
    } 

    # A fallback for forms that don't have any named fields except their
    # submit button. Could stand to be refactored.
    $i = 0;
    for my $form ($self->forms) {
        no warnings 'uninitialized';

        $i++;
        next unless first {   $_->name =~ /J:A-(?:\d+-)?$moniker/
                           && $_->type eq "submit" }
                        $form->inputs;
        next if grep {not $form->find_input("J:A:F-$_-$moniker")} @fields;

        $self->form_number($i); #select it, for $mech->submit etc
        return $form;
    } 
    return;
} 

sub action_field_input {
    my $self = shift;
    my $moniker = shift;
    my $field = shift;

    my $action_form = $self->action_form($moniker, $field);
    return unless $action_form;

    my $input = $action_form->find_input("J:A:F-$field-$moniker");
    return $input;
}

sub action_field_value {
    my $self = shift;
    my $input = $self->action_field_input(@_);
    return $input ? $input->value : undef;
}

sub _build_webservices_request {
    my ($self, $endpoint, $data) = @_;

    my $uri = $self->uri->clone;
    $uri->path($endpoint);
    $uri->query('');

    my $body = Jifty::YAML::Dump({ path => $endpoint, %$data});

    HTTP::Request->new(
        POST => $uri,
        [ 'Content-Type' => 'text/x-yaml',
          'Content-Length' => length($body) ],
        $body
    );
}

sub send_action {
    my $self = shift;
    my $class = shift;
    my %args = @_;

    my $request = $self->_build_webservices_request
        ( "__jifty/webservices/yaml",
          { actions => {
                action => {
                    moniker => 'action',
                    class   => $class,
                    fields  => \%args
                }
            }
        });

    my $result = $self->request( $request );
    my $content = eval { Jifty::YAML::Load($result->content)->{action} } || undef;
    $self->back;
    return $content;
}

sub fragment_request {
    my $self = shift;
    my $path = shift;
    my %args = @_;

    my $request = $self->_build_webservices_request
        ( "__jifty/webservices/xml",
          { fragments => {
                fragment => {
                    name  => 'fragment',
                    path  => $path,
                    args  => \%args
                }
            }
        });

    my $result = $self->request( $request );

    use XML::Simple;
    my $content = eval { XML::Simple::XMLin($result->content, SuppressEmpty => '')->{fragment}{content} } || '';
    $self->back;
    return $content;
}

sub field_error_text {
    my $self = shift;
    my $moniker = shift;
    my $field = shift;

    # Setup the XPath processor and the ID we're looking for
    my $tree = HTML::TreeBuilder::XPath->new;
    $tree->parse($self->content);
    $tree->eof;

    my $id = "errors-J:A:F-$field-$moniker";

    # Search for the span containing that error
    return $tree->findvalue(qq{//span[\@id = "$id"]});
}

sub uri { shift->response->request->uri }

sub get_html_ok {
    my $self = shift;
    $self->get(@_);
    {
        local $Test::Builder::Level = $Test::Builder::Level;
        $Test::Builder::Level++;
        Test::HTML::Lint::html_ok( $lint, $self->content, "html_ok for ".$self->uri );
    }
}

sub html_ok {
    my $self    = shift;
    my $content = shift || $self->content;
    {
        local $Test::Builder::Level = $Test::Builder::Level;
        $Test::Builder::Level++;
        Test::HTML::Lint::html_ok( $lint, $content );
    }
}

sub submit_html_ok {
    my $self = shift;
    $self->submit(@_);
    {
        local $Test::Builder::Level = $Test::Builder::Level;
        $Test::Builder::Level++;
        Test::HTML::Lint::html_ok( $lint, $self->content );
    }
} 

sub follow_link_ok {
    my $self = shift;


    my $desc;

    # Test::WWW::Mechanize allows passing in a hashref of arguments, so we should to
    if  ( ref($_[0]) eq 'HASH') {
        # if the user is pashing in { text => 'foo' } ...
        $desc = $_[1] if $_[1];
        @_ = %{$_[0]};
    } elsif (@_ % 2 ) {
        # IF the user is passing in text => 'foo' ,"Cicked the right thing"
        # Remove reason from end if it's there
        $desc = pop @_ ;
    }

    carp("Couldn't find link") unless $self->follow_link(@_);
    {
        local $Test::Builder::Level = $Test::Builder::Level;
        $Test::Builder::Level++;
        Test::HTML::Lint::html_ok( $lint, $self->content, $desc );
    }
}

sub warnings_like {
    my $self = shift;
    my @args = shift;
    @args = @{$args[0]} if ref $args[0] eq "ARRAY";
    my $reason = pop || "Server warnings matched";

    local $Test::Builder::Level = $Test::Builder::Level;
    $Test::Builder::Level++;

    my $plugin = Jifty->find_plugin("Jifty::Plugin::TestServerWarnings");
    my @warnings = $plugin->decoded_warnings($self->uri);
    my $max = @warnings > @args ? $#warnings : $#args;
    for (0 .. $max) {
        like($warnings[$_], $_ <= $#args ? qr/$args[$_]/ : qr/(?!unexpected)unexpected warning/, $reason);
    }
}

sub no_warnings_ok {
    my $self = shift;
    my $reason = shift || "no warnings emitted";

    local $Test::Builder::Level = $Test::Builder::Level;
    $Test::Builder::Level++;

    my $plugin   = Jifty->find_plugin("Jifty::Plugin::TestServerWarnings");
    my @warnings = $plugin->decoded_warnings( $self->uri );

    is( @warnings, 0, $reason );
    for (@warnings) {
        diag("got warning: $_");
    }
}

sub session {
    my $self = shift;

    my $cookie = Jifty->config->framework('Web')->{'SessionCookieName'};
    $cookie =~ s/\$PORT/(?:\\d+|NOPORT)/g;

    return undef unless $self->cookie_jar->as_string =~ /$cookie=([^;]+)/;

    my $session = Jifty::Web::Session->new;
    $session->load($1);
    return $session;
}

sub continuation {
    my $self = shift;

    my $session = $self->session;
    return undef unless $session;
    
    my $id = shift;
    ($id) = $self->uri =~ /J:(?:C|CALL|RETURN)=([^&;]+)/ unless $id;

    return $session->get_continuation($id);
}

sub current_user {
    my $self = shift;

    my $session = $self->session;
    return undef unless $session;

    my $id = $session->get('user_id');

    return undef unless ($id);

    my $object = Jifty->app_class("CurrentUser")->new(id => $id);
    return $object;
}


1;