Mozilla::Mechanize - Like WWW::Mechanize but using Gtk2::MozEmbed

    use Mozilla::Mechanize;

    my $moz = Mozilla::Mechanize->new();

    $moz->get( $url );

    $moz->follow_link( text => $link_txt );

    $moz->form_name( $form_name );
    $moz->set_fields(
        username => 'yourname',
        password => 'dummy'
    );
    $moz->click( $btn_name );

    # Or all in one go:
    $moz->submit_form(
        form_name => $form_name,
        fields    => {
            username => 'yourname',
            password => 'dummy',
        },
        button    => $btn_name,
    );

    $moz->find_link( text => "News", url_regex => qr/cnn\.com/ );

    $moz->find_image( image => "News", url_regex => qr/cnn\.com/ );

        # set the second foo field
        $moz->set_fields( $name => [ 'foo', 2 ] ) ;

    $moz->set_visible( $username, $password ) ;

    $moz->set_visible( [ radio => "KCRW" ] ) ;

    $moz->set_visible( "fred", "secret", [ select => "Checking" ] ) ;

    $moz->add_header( Encoding => 'text/klingon' );

    $moz->add_header( Referer => undef );

    $a->quiet(0); # turns on warnings (the default)
    $a->quiet(1); # turns off warnings
    $a->quiet();  # returns the current quietness status

package Mozilla::Mechanize;
use strict;
use warnings;

# $Id: Mechanize.pm,v 1.4 2005/10/07 12:17:20 slanning Exp $
our $VERSION = '0.06';

use Glib qw(FALSE G_PRIORITY_LOW);
use URI;

use Mozilla::DOM '0.22';
use Mozilla::Mechanize::Browser;
use Mozilla::Mechanize::Form;
use Mozilla::Mechanize::Input;
use Mozilla::Mechanize::Link;
use Mozilla::Mechanize::Image;

my %moz_property = (
#    addressbar => { type => 'b', value => undef },
    fullscreen => { type => 'b', value => 0 },
#    resizable  => { type => 'b', value => undef },
#    statusbar  => { type => 'b', value => undef },
#    toolbar    => { type => 'b', value => undef },
    visible    => { type => 'b', value => 1     },
    width      => { type => 'n', value => 600   },
    height     => { type => 'n', value => 400   },
#    left       => { type => 'n', value => undef },
#    top        => { type => 'n', value => undef },
);

sub new {
    my $class = shift;

    my $self = bless {
        _opt    => {},
        onwarn  => \&Mozilla::Mechanize::__warn,
        onerror => \&Mozilla::Mechanize::__die,
        quiet   => 0,
        debug   => 0,
    }, $class;

    my %opt = @_ ? UNIVERSAL::isa( $_[0], 'HASH' ) ? %{ $_[0] } : @_ : ();

#    $self->{_opt} = { map {
#        ( $_ => __prop_value( $_, $opt{ $_ } ) )
#    } grep exists $moz_property{ lc $_ } => keys %opt };
    # Sets all default values (before it only set ones passed in)
    $self->{_opt} = { map {
        my $prop = lc $_;
        ($prop => __prop_value($prop, $opt{$prop}))
    } keys %moz_property };

    # some more options not for Browser
    $self->{$_} = exists $opt{$_} ? $opt{$_} : undef
        for qw(quiet debug onwarn onerror);

    $self->open();
}

sub set_property {
    my $self = shift;

    my %raw = @_ ? UNIVERSAL::isa( $_[0], 'HASH' ) ? %{ $_[0] } : @_ : ();
    my %opt = map {
        ( $_ => __prop_value( $_, $raw{ $_ } ) )
    } grep exists $moz_property{ lc $_ } => keys %raw;

    foreach my $prop ( keys %opt ) {
        defined $opt{ $prop } and
          $self->agent->{ $prop } = $opt{ $prop };
    }
}

sub close {
    my $self = shift;
    $self->agent->quit();
    $self->{agent} = undef;

    # XXX: do we need to run the GUI here?
}

sub open {
    my $self = shift;
    defined $self->{agent} and return;

    my $browser_opts = $self->{_opt};
    $browser_opts->{debug} = $self->{debug};

    $self->{agent} = Mozilla::Mechanize::Browser->new($browser_opts)
      or $self->die("Cannot create a new Browser");

#    foreach my $prop ( keys %{ $self->{_opt} } ) {
#        defined $self->{_opt}{ $prop } and
#            $self->{agent}->{ $prop } = $self->{_opt}{ $prop };
#    }

    return $self;
}

sub agent { $_[0]->{agent} }

sub get {
    my $self = shift;
    my $agent = $self->agent;
    my ($url) = @_;

    my $uri = $self->uri
        ? URI->new_abs($url, $self->uri->as_string)
        : URI->new($url);

    # XXX: how to add headers?
#    $agent->navigate({ URL     => $uri->as_string,
#                       Headers => $self->_extra_headers($uri) });

    $agent->embedded->load_url($uri->as_string);
    $self->_wait_while_busy;
}

sub reload {
    $_[0]->agent->embedded->reload('reloadnormal');
    $_[0]->_wait_while_busy;
}

sub back {
    $_[0]->agent->embedded->go_back;
    $_[0]->_wait_while_busy;
}

sub success {
#    $_[0]->agent->ReadyState >= 2;

    # XXX: uh??

    return 1;
}

sub uri {
    my $self = shift;
    my $agent = $self->agent;
    my $embed = $agent->embedded;
    my $uri = $embed->get_location;
    URI->new($uri);
}

sub ct {
    my $self = shift;

    my $doc = $self->get_document;
    my $diid = Mozilla::DOM::NSDocument->GetIID;
    my $nsdoc = $doc->QueryInterface($diid);
    return $nsdoc->GetContentType;
}

sub current_form {
    my $self = shift;
    defined $self->{cur_form} or $self->form_number( 1 );
    $self->{cur_form};
}

sub is_html {
    my $self = shift;
    return $self->ct eq 'text/html';
}

sub title { $_[0]->agent->embedded->get_title }

sub content {
    my $self = shift;
    my $embed = $self->agent->embedded;
    my $html = '';

    # Boohoo, no outerHTML
    my $docelem = $self->get_document_element();

    # Try to output <html> with any attributes
    $html .= '<' . lc($docelem->GetNodeName);
    if ($docelem->HasAttributes) {
        $html .= ' ';
        my $attrs = $docelem->GetAttributes;
        for (my $i = 0; $i < $attrs->GetLength; $i++) {
            my $attr = $attrs->Item($i);
            $html .= $attr->GetNodeName . '="' . $attr->GetNodeValue . '" ';
        }
    }
    $html .= ">\n";

    # Add <body> ... </body>
    my $iid = Mozilla::DOM::NSHTMLElement->GetIID;
    my $nshtmlelement = $docelem->QueryInterface($iid);
    $html .= $nshtmlelement->GetInnerHTML;

    # Add back the closing html tag
    $html .= "\n</html>\n";

    return $html;
}

sub links {
    my $self = shift;

    defined $self->{links} or $self->{links} = $self->_extract_links();

    return wantarray ? @{ $self->{links} } : $self->{links};
}

sub follow_link {
    my $self = shift;
    my %parms = ( n => 1, @_ );

    if ( $parms{n} eq "all" ) {
        delete $parms{n};
        $self->warn( qq{follow_link( n => "all" ) is not valid} );
    }

    my $link = $self->find_link( @_ );
    $self->get( $link->url ) if $link;
}

sub find_link {
    my $self = shift;
    my %parms = ( n=>1, @_ );

    my $wantall = ( $parms{n} eq "all" );

    $self->_clean_keys(
        \%parms,
        qr/^(n|(text|url|url_abs|name|tag)(_regex)?)$/
    );

    my @links = $self->links or return;

    my $nmatches = 0;
    my @matches;
    for my $link ( @links ) {
        if ( _match_any_link_parms($link,\%parms) ) {
            if ( $wantall ) {
                push( @matches, $link );
            } else {
                ++$nmatches;
                return $link if $nmatches >= $parms{n};
            }
        }
    } # for @links

    if ( $wantall ) {
        return @matches if wantarray;
        return \@matches;
    }

    return;
}

# Stolen from WWW::Mechanize-1.08
# Used by find_links to check for matches
# The logic is such that ALL parm criteria that are given must match
sub _match_any_link_parms {
    my $link = shift;
    my $p = shift;

    # No conditions, anything matches
    return 1 unless keys %$p;

    return if defined $p->{url}
        and !( $link->url eq $p->{url} );
    return if defined $p->{url_regex}
        and !( $link->url =~ $p->{url_regex} );
    return if defined $p->{url_abs}
        and !( $link->url_abs eq $p->{url_abs} );
    return if defined $p->{url_abs_regex}
        and !( $link->url_abs =~ $p->{url_abs_regex} );
    return if defined $p->{text}
        and !( defined($link->text) and $link->text eq $p->{text} );
    return if defined $p->{text_regex}
        and !( defined($link->text) and $link->text =~ $p->{text_regex} );
    return if defined $p->{name}
        and !( defined($link->name) and $link->name eq $p->{name} );
    return if defined $p->{name_regex}
        and !( defined($link->name) and $link->name =~ $p->{name_regex} );
    return if defined $p->{tag}
        and !( $link->tag and lc( $link->tag ) eq lc( $p->{tag} ) );
    return if defined $p->{tag_regex}
        and !( $link->tag and $link->tag =~ $p->{tag_regex} );

    # Success: everything that was defined passed.
    return 1;
}

# Cleans the %parms parameter for the find_link and find_image methods.
sub _clean_keys {
    my $self = shift;
    my $parms = shift;
    my $rx_keyname = shift;

    for my $key ( keys %$parms ) {
        my $val = $parms->{$key};
        if ( $key !~ qr/$rx_keyname/ ) {
            $self->warn( qq{Unknown link-finding parameter "$key"} );
            delete $parms->{$key};
            next;
        }

        my $key_regex = ( $key =~ /_regex$/ );
        my $val_regex = ( ref($val) eq "Regexp" );

        if ( $key_regex ) {
            if ( !$val_regex ) {
                $self->warn( qq{$val passed as $key is not a regex} );
                delete $parms->{$key};
                next;
            }
        } else {
            if ( $val_regex ) {
                $self->warn( qq{$val passed as '$key' is a regex} );
                delete $parms->{$key};
                next;
            }
            if ( $val =~ /^\s|\s$/ ) {
                $self->warn( qq{'$val' is space-padded and cannot succeed} );
                delete $parms->{$key};
                next;
            }
        }
    } # for keys %parms
} # _clean_keys()

sub find_all_links {
    my $self = shift;
    $self->find_link( @_, n => 'all' );
}

sub images {
    my $self = shift;

    $self->_extract_images unless defined $self->{images};

    return wantarray ? @{ $self->{images} } : $self->{images};
}

sub find_image {
    my $self = shift;
    my %parms = ( n=>1, @_ );

    my $wantall = ( $parms{n} eq "all" );

    $self->_clean_keys( \%parms, qr/^(n|(alt|url|url_abs|tag)(_regex)?)$/ );

    my @images = $self->images or return;

    my $nmatches = 0;
    my @matches;
    for my $image ( @images ) {
        if ( _match_any_image_parms($image,\%parms) ) {
            if ( $wantall ) {
                push( @matches, $image );
            } else {
                ++$nmatches;
                return $image if $nmatches >= $parms{n};
            }
        }
    } # for @images

    if ( $wantall ) {
        return @matches if wantarray;
        return \@matches;
    }

    return;
}

# Used by find_images to check for matches
# The logic is such that ALL parm criteria that are given must match
sub _match_any_image_parms {
    my $image = shift;
    my $p = shift;

    # No conditions, anything matches
    return 1 unless keys %$p;

    return if defined $p->{url}
        and !( $image->url eq $p->{url} );
    return if defined $p->{url_regex}
        and !( $image->url =~ $p->{url_regex} );
    return if defined $p->{url_abs}
        and !( $image->url_abs eq $p->{url_abs} );
    return if defined $p->{url_abs_regex}
        and !( $image->url_abs =~ $p->{url_abs_regex} );
    return if defined $p->{alt}
        and !( defined($image->alt) and $image->alt eq $p->{alt} );
    return if defined $p->{alt_regex}
        and !( defined($image->alt) and $image->alt =~ $p->{alt_regex} );
    return if defined $p->{tag}
        and !( $image->tag and lc( $image->tag ) eq lc( $p->{tag} ) );
    return if defined $p->{tag_regex}
        and !( $image->tag and $image->tag =~ $p->{tag_regex} );

    # Success: everything that was defined passed.
    return 1;
}

sub find_all_images {
    my $self = shift;
    return $self->find_image( @_, n=>'all' );
}

sub forms {
    my $self = shift ;
    $self->_extract_forms unless defined $self->{forms};

    return wantarray ? @{ $self->{forms} } : $self->{forms};
}

sub form_number {
    my $self = shift;

    my $number = shift || 1;
    $self->_extract_forms unless defined $self->{forms};
    if ( @{ $self->{forms} } && $number <= @{ $self->{forms} } ) {
        $self->{cur_form} = $self->{forms}[ $number - 1 ];
    } else {
        $self->warn( "There is no form numbered $number." );
        return undef;
    }
}

sub form_name {
    my $self = shift;

    my $name = shift or return undef;
    $self->_extract_forms unless defined $self->{forms};
    my @matches = grep $_->name && $_->name eq $name => @{ $self->{forms} };
    if ( @matches ) {
        $self->warn( "There are " . scalar @matches . "forms named '$name'. " .
                     "The first one was used." ) if @matches > 1;
        $self->{cur_form} = $matches[0];
    } else {
        $self->warn( "There is no form named '$name'." );
        return undef;
    }
}

sub field {
    my $self = shift;

    my( $name, $value, $index ) = @_;
    my $form = $self->current_form;

    my @inputs = $form->find_input( $name );
    $self->debug('field: num inputs = ' . scalar(@inputs));

    @inputs or $self->warn( "No '$name' parameter exists" );
    $index ||= 1;
    my $control = $inputs[ $index - 1 ];
    defined $value ? $control->value( $value ) : $control->value();
}

sub select {
    my $self = shift;
    my( $name, $value ) = @_;

    my $form = $self->current_form;
    my $input = $form->find_input( $name, 'select' );
    if ( !$input ) {
        $self->warn( "Select '$name' not found." );
        return;
    }
    $input->select_value( $value );
    return 1;
}

sub set_fields {
    my $self = shift;

    my $form = $self->current_form;
    my %opt = @_ ? UNIVERSAL::isa( $_[0], 'HASH' ) ? %{ $_[0] } : @_ : ();
    while ( my( $fname, $value ) = each %opt ) {
        if ( ref $value eq 'ARRAY' ) {
            my( $input ) = $form->find_input( $fname, undef, $value->[1] );
            if ( $input ) {
                $input->value( $value->[0] );
            } else {
                $self->warn( "No inputcontrol by the name '$fname'" );
            }
        } else {
            my( $input ) = $form->find_input( $fname );
            if ( $input ) {
                $input->value( $value );
            } else {
                $self->warn( "No inputcontrol by the name '$fname'" );
            }
        }
    }
}

sub set_visible {
    my $self = shift;

    my $form = $self->current_form;
    my @inputs = $form->inputs;

    while (my $value = shift) {
        if (ref $value eq 'ARRAY') {
           my ($type, $val) = @$value;
           while (my $input = shift @inputs) {
               next if $input->type eq 'hidden';
               if ($input->type eq $type) {
                   $input->value($val);
                   last;
               }
           }
        } else {
           while (my $input = shift @inputs) {
               next if $input->type eq 'hidden';
               $input->value($value);
               last;
           }
       }
    }
}

sub tick {
    my $self = shift;

    my $form = $self->current_form;

    my( $name, $value, $set ) = @_;
    $set = 1 if @_ <= 2;
    my @check_boxes = grep $_->value eq $value
        => $form->find_input( $name, 'checkbox' );

    $self->warn( "No checkbox '$name'  for value '$value' in form." ), return
        unless @check_boxes;

    foreach my $check_box ( @check_boxes ) {
        next unless $check_box->value eq $value;
        # XXX: breaks encapsulation
        $check_box->{input}->SetChecked($set || 0);
    }
    return 1;
}

sub untick {
    my $self = shift;
    $self->tick( @_[0, 1], undef );
}

sub value {
    my $self = shift;
    my $name = shift;
    my $number = shift || 1;

    my $form = $self->current_form;
    if ( wantarray ) {
        my @inputs = $form->find_input( $name );
        return @inputs ? map $_->value() => @inputs : undef;
    }
    if ( $number > 1 ) {
        return $form->find_input( $name, undef, $number )->value();
    } else {
        return $form->value( $name );
    }
}

sub click {
    my ($self, $button) = @_;

    my $form = $self->current_form;

    # XXX: this is unsorted
    my ($toclick) = (
        $form->find_input( $button, 'button' ),
        $form->find_input( $button, 'image' ),
        $form->find_input( $button, 'submit' ),
    );

    $toclick and $toclick->click();
}

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

    for ( keys %args ) {
        if ( !/^(number|name|value)$/ ) {
            $self->warn( qq{Unknown click_button_form parameter "$_"} );
        }
    }

    my $form = $self->current_form;
    # XXX: this is unsorted
    my @buttons = (
        $form->find_input( $args{name}, 'button' ),
        $form->find_input( $args{name}, 'image' ),
        $form->find_input( $args{name}, 'submit' ),
    );

    @buttons or return;
    if ( $args{name} ) {
        $buttons[0]->click();
        return 1;
    } elsif ( $args{number} ) {
        @buttons <= $args{number} and return
        $buttons[ $args{number} - 1 ]->click();
        return 1;
    } elsif ( $args{value} ) {
        for my $button ( @buttons ) {
            if ( $button->value eq $args{value} ) {
                $button->click();
                return 1;
            }
        }
    }
}

sub submit {
    my $self = shift;

    my $form = $self->current_form;

    $form->submit();
}

sub submit_form {
    my $self = shift;

    my %opt = @_;
    if ( my $form_number = $opt{form_number} ) {
        $self->form_number( $form_number ) ;
    }
    elsif ( my $form_name = $opt{form_name} ) {
        $self->form_name( $form_name ) ;
    } else {
        $self->form_number( 1 ) unless defined $self->{cur_form};
    }

    if ( my $fields = $opt{fields} ) {
        if ( ref $fields eq 'HASH' ) {
            $self->set_fields( %{$fields} ) ;
        } # TODO: What if it's not a hash?  We just ignore it silently?
    }

    if ( $opt{button} ) {
        if ( ref $opt{button} ) {
            $self->click_button( %{ $opt{button} } );
        } else {
            $self->click( $opt{button} );
        }
    } else {
        $self->submit();
    }

    return $self->success;
}

sub add_header {
    my $self = shift;
    my $npairs = 0;

    while ( @_ ) {
        my $key = shift;
        my $value = shift;
        ++$npairs;

        $self->{headers}{$key} = $value;
    }

    return $npairs;
}

sub delete_header {
    my $self = shift;

    while ( @_ ) {
        my $key = shift;
        delete $self->{headers}{$key};
    }
}

sub quiet {
    my $self = shift;

    $self->{quiet} = $_[0] if @_;

    return $self->{quiet};
}

sub find_frame {
    my ($self, $frame) = @_;

    # XXX: there must be an easier way than this...?
    my $docelem = $self->get_document_element;
    my $framelist = $docelem->GetElementsByTagName('frame');
    for (my $i = 0; $i < $framelist->GetLength; $i++) {
        my $frame_elem = $framelist->Item($i);
        if ($frame_elem->HasAttributes) {
            my $attrs = $frame_elem->GetAttributes;
            my %attrs = ();
            for (my $j = 0; $j < $attrs->GetLength; $j++) {
                my $attr = $attrs->Item($j);
                $attrs{lc($attr->GetNodeName)} = $attr->GetNodeValue;
            }

            if ($attrs{'name'} eq $frame) {
                return (URI->new_abs($attrs{'src'}, $self->uri))->as_string;
            }
        }
    }

    return;
}

sub load_frame {
    my( $self, $frame ) = @_;
    $self->get( $self->find_frame($frame) );
}

sub get_window {
    my $self = shift;
    my $embed = $self->agent->embedded;
    my $browser = $embed->get_nsIWebBrowser;
    return $browser->GetContentDOMWindow;
}

sub get_document {
    my $self = shift;
    my $window = $self->get_window;
    return $window->GetDocument;
}

sub get_document_element {
    my $self = shift;
    my $doc = $self->get_document;
    return $doc->GetDocumentElement;
}

sub credentials {
    my($self, $netloc, $realm, $uid, $pass) = @_;
    $self->{basic_authentication}{ $netloc }{ $realm } = [ $uid, $pass ];
    $self->{basic_authentication}{ $netloc }{__active_realm__} = $realm;
}

sub get_basic_credentials {
    my($self, $realm, $uri ) = @_;

    my $host_port = $uri->can( 'host_port' )
        ? $uri->host_port : $uri->as_string;

    $realm ||= $self->{basic_authentication}{ $host_port }{__active_realm__};
    $realm or return ( );

    if ( exists $self->{basic_authentication}{ $host_port }{ $realm } ) {
        return @{ $self->{basic_authentication}{ $host_port }{ $realm } };
    }

    return ( );
}

sub set_realm {
    my( $self, $netloc, $realm ) = @_;
    $netloc or return;
    defined $realm or $realm = "";
    $self->{basic_authentication}{ $netloc }{__active_realm__} = $realm;
}

sub DESTROY {
    my $agent = shift->agent;
    $agent && $agent->quit;
}

sub _extract_forms {
    my $self = shift;
    my @forms;

    my $docelem = $self->get_document_element;
    my $formlist = $docelem->GetElementsByTagName('form');
    for (my $i = 0; $i < $formlist->GetLength; $i++) {
        push @forms, Mozilla::Mechanize::Form->new($formlist->Item($i), $self);
    }
    $self->{forms} = \@forms;

    return wantarray ? @{ $self->{forms} } : $self->{forms};
}

{
    # Recursively get link elements. This is necessary in order
    # to preserve their order. Too bad Mozilla doesn't have
    # an `all' method like Internet Explorer.

    my @links;

    sub _extract_links {
        my ($self, $subelement) = @_;
        my $node;

        # The first time, it's called with no subelement
        if (defined $subelement) {
            $node = $subelement;
        } else {
            @links = ();
            $node = $self->get_document_element;
        }

        # If it's a link element, get it; otherwise, recurse if has children
        if ($node->GetNodeName =~ /^(iframe|frame|area|a)$/i) {
            my $tagname = lc $1;

            if ($tagname eq 'a') {
                # Element interface is more convenient for attributes
                my $element = $node->QueryInterface(Mozilla::DOM::Element->GetIID);
                # <a> are links only if they have an href
                push @links, Mozilla::Mechanize::Link->new($element, $self)
                  if $element->HasAttribute('href');
                $self->debug("added '$tagname' link");
            } else {
                push @links, Mozilla::Mechanize::Link->new($node, $self);
                $self->debug("added '$tagname' link");
            }
        } elsif ($node->HasChildNodes) {
            my @children = $node->GetChildNodes;
            # skips #text nodes
            foreach my $child (grep {$_->GetNodeName !~ /^#/} @children) {
                $self->_extract_links($child);
            }
        }

        # Continue only at the top-level
        return if defined $subelement;

        $self->{links} = \@links;
        return wantarray ? @{ $self->{links} } : $self->{links};
    }
}

{
    # Recursively get image elements. This is necessary in order
    # to preserve their order. Too bad Mozilla doesn't have
    # an `all' method like Internet Explorer.

    my @images;

    sub _extract_images {
        my ($self, $subelement) = @_;
        my $node;

        # The first time, it's called with no subelement
        if (defined $subelement) {
            $node = $subelement;
        } else {
            @images = ();
            $node = $self->get_document_element;
        }

        # If it's an image element, get it; otherwise, recurse if has children
        if ($node->GetNodeName =~ /^(img|input)$/i) {
            my $tagname = lc $1;

            if ($tagname eq 'input') {
                # Element interface is more convenient for attributes
                my $element = $node->QueryInterface(Mozilla::DOM::Element->GetIID);
                # <input> are images only if they have a src
                # (XXX: or maybe should be if type="image"...)
                push @images, Mozilla::Mechanize::Image->new($element, $self)
                  if $element->HasAttribute('src');
                $self->debug("added '$tagname' image");
            } else {
                push @images, Mozilla::Mechanize::Image->new($node, $self);
                $self->debug("added '$tagname' image");
            }
        } elsif ($node->HasChildNodes) {
            my @children = $node->GetChildNodes;
            # skips #text nodes
            foreach my $child (grep {$_->GetNodeName !~ /^#/} @children) {
                $self->_extract_images($child);
            }
        }

        # Continue only at the top-level
        return if defined $subelement;

        $self->{images} = \@images;
        return wantarray ? @{ $self->{forms} } : $self->{forms};
    }
}

sub _wait_while_busy {
    my $self = shift;
    my $agent = $self->agent;

    do {
        Glib::Idle->add(sub {
            Gtk2->main_quit;
            FALSE;  # uninstall
        }, undef, G_PRIORITY_LOW);
        Gtk2->main;
    } until $agent->{netstopped};

    $self->{$_} = undef for qw(forms cur_form links images);
    return $self->success;
}

sub warn {
    my $self = shift;

    return unless my $handler = $self->{onwarn};

    return if $self->quiet;

    $handler->(@_);
}

sub die {
    my $self = shift;

    return unless my $handler = $self->{onerror};

    $handler->(@_);
}

# Not a method
sub __warn {

    eval "require Carp";
    if ( $@ ) {
        CORE::warn @_;
    } else {
        &Carp::carp;
    }
}

# Not a method
sub __die {
    require Carp;
    &Carp::croak; # pass thru
}

sub debug {
    my ($self, $msg) = @_;
    my (undef, $file, $line) = caller();
    print STDERR "$msg at $file line $line\n" if $self->{debug};
}

sub _extra_headers {
    my( $self, $uri ) = @_;

    my $header = "";

    for my $header ( keys %{ $self->{headers} } ) {
        next unless defined $self->{headers}{ $header };
        ( my $hfield = $header ) =~ s/(\w+)/ucfirst lc $1/eg;
        $header .= "$hfield: $self->{headers}{ $header }\015\012";
    }

    my $host_port = $uri->can( 'host_port' )
        ? $uri->host_port : $uri->as_string;
    return $header unless exists $self->{basic_authentication}{ $host_port };

    my $realm = $self->{basic_authentication}{ $host_port }{__active_realm__};
    my( $user, $pass ) = $self->get_basic_credentials( $realm, $uri );

    $header .= defined $user ? __authorization_basic( $user, $pass ) : "";

    return $header;
}

sub __prop_value($;$) {
    my ($key, $value) = @_;
    $key = lc $key;

    exists $moz_property{$key} or return undef;
    @_ > 1 or return $moz_property{$key}{value};

    CASE: {
        local $_ = $moz_property{ $key }{type};

        /^b$/ and do {
            defined $value or return $moz_property{$key}{value};
            return $value ? 1 : 0;
        };
        /^n$/ and do {
            defined $value or return $moz_property{$key}{value};
            return $value =~ /((?:\+|-)?[0-9]+)/ ? $1 : 0;
        };
    }
}

sub __authorization_basic {
    my( $user, $pass ) = @_;
    defined $user && defined $pass or return;

    require MIME::Base64;
    return "Authorization: Basic " .
           MIME::Base64::encode_base64( "$user:$pass" ) .
           "\015\012";
}


1;