view release on metacpan or  search on metacpan

lib/Selenium/Firefox/Profile.pm  view on Meta::CPAN

package Selenium::Firefox::Profile;
$Selenium::Firefox::Profile::VERSION = '1.50';
# ABSTRACT: Use custom profiles with Selenium::Remote::Driver
# TODO: convert this to Moo!

use strict;
use warnings;

use Archive::Zip qw( :ERROR_CODES );
use Carp qw(croak);
use Cwd qw(abs_path);
use File::Copy qw(copy);
use File::Temp;
use File::Basename qw(dirname);
use IO::Uncompress::Unzip 2.030 qw($UnzipError);
use JSON qw(decode_json);
use MIME::Base64;
use Scalar::Util qw(blessed looks_like_number);
use XML::Simple;



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

    my $profile_dir;
    if ( $args{profile_dir} && -d $args{profile_dir} ) {
        $profile_dir = $args{profile_dir};
    }
    else {
        $profile_dir = File::Temp->newdir();
    }

    # TODO: accept user prefs, boolean prefs, and extensions in
    # constructor
    my $self = {
        profile_dir => $profile_dir,
        user_prefs  => {},
        extensions  => []
    };
    bless $self, $class or die "Can't bless $class: $!";

    return $self;
}


sub set_preference {
    my ( $self, %prefs ) = @_;

    foreach ( keys %prefs ) {
        my $value       = $prefs{$_};
        my $clean_value = '';

        if ( JSON::is_bool($value) ) {
            $self->set_boolean_preference( $_, $value );
            next;
        }
        elsif ( $value =~ /^(['"]).*\1$/ or looks_like_number($value) ) {

            # plain integers: 0, 1, 32768, or integers wrapped in strings:
            # "0", "1", "20140204". in either case, there's nothing for us
            # to do.
            $clean_value = $value;
        }
        else {
            # otherwise it's hopefully a string that we'll need to
            # quote on our own
            $clean_value = '"' . $value . '"';
        }

        $self->{user_prefs}->{$_} = $clean_value;
    }
}


sub set_boolean_preference {
    my ( $self, %prefs ) = @_;

    foreach ( keys %prefs ) {
        my $value = $prefs{$_};

        $self->{user_prefs}->{$_} = $value ? 'true' : 'false';
    }
}


sub get_preference {
    my ( $self, $pref ) = @_;

    return $self->{user_prefs}->{$pref};
}


sub add_extension {
    my ( $self, $xpi ) = @_;

    croak 'File not found: ' . $xpi unless -e $xpi;
    my $xpi_abs_path = abs_path($xpi);
    croak '$xpi_abs_path: extensions must be in .xpi format'
      unless $xpi_abs_path =~ /\.xpi$/;

    push( @{ $self->{extensions} }, $xpi_abs_path );
}


sub add_webdriver {
    my ( $self, $port, $is_marionette ) = @_;

    my $current_user_prefs = $self->{user_prefs};

    $self->set_preference(
        # having the user prefs here allows them to overwrite the
        # mutable loaded prefs
        %{$current_user_prefs},

        # but the frozen ones cannot be overwritten
        'webdriver_firefox_port' => $port
    );

    if ( !$is_marionette ) {
        $self->_add_webdriver_xpi;
    }

    return $self;
}



sub _add_webdriver_xpi {
    my ($self) = @_;

    my $this_dir            = dirname( abs_path(__FILE__) );
    my $webdriver_extension = $this_dir . '/webdriver.xpi';

    $self->add_extension($webdriver_extension);
}


sub add_marionette {
    my ( $self, $port ) = @_;
    return if !$port;
    $self->set_preference( 'marionette.defaultPrefs.port', $port );
}

sub _encode {
    my $self = shift;

    # The remote webdriver accepts the Firefox profile as a base64
    # encoded zip file
    $self->_layout_on_disk();

    my $zip = Archive::Zip->new();
    $zip->addTree( $self->{profile_dir} );

    my $string = "";
    open( my $fh, ">", \$string );
    binmode($fh);
    unless ( $zip->writeToFileHandle($fh) == AZ_OK ) {
        die 'write error';
    }

    return encode_base64( $string, '' );
}

sub _layout_on_disk {
    my $self = shift;

    $self->_write_preferences();
    $self->_install_extensions();

    return $self->{profile_dir};
}

sub _write_preferences {
    my $self = shift;

    my $userjs = $self->{profile_dir} . "/user.js";
    open( my $fh, ">>", $userjs )
      or die "Cannot open $userjs for writing preferences: $!";

    foreach ( keys %{ $self->{user_prefs} } ) {
        print $fh 'user_pref("'
          . $_ . '", '
          . $self->get_preference($_) . ');' . "\n";
    }
    close($fh);
}

sub _install_extensions {
    my $self          = shift;
    my $extension_dir = $self->{profile_dir} . "/extensions/";
    mkdir $extension_dir unless -d $extension_dir;

    # TODO: handle extensions that need to be unpacked
    foreach my $xpi ( @{ $self->{extensions} } ) {

        # For Firefox to recognize the extension, we have to put the
        # .xpi in the /extensions/ folder and change the filename to
        # its id, which is found in the install.rdf in the root of the
        # zip.

        my $rdf_string = $self->_extract_install_rdf($xpi);
        my $rdf        = XMLin($rdf_string);
        my $name       = $rdf->{Description}->{'em:id'};

        my $xpi_dest = $extension_dir . $name . ".xpi";
        copy( $xpi, $xpi_dest )
          or croak "Error copying $_ to $xpi_dest : $!";
    }
}

sub _extract_install_rdf {
    my ( $self, $xpi ) = @_;

    my $unzipped = IO::Uncompress::Unzip->new($xpi)
      or die "Cannot unzip $xpi: $UnzipError";

    my $install_rdf = '';
    while ( $unzipped->nextStream ) {
        my $filename = $unzipped->getHeaderInfo->{Name};
        if ( $filename eq 'install.rdf' ) {
            my $buffer;
            while ( ( my $status = $unzipped->read($buffer) ) > 0 ) {
                $install_rdf .= $buffer;
            }
            return $install_rdf;
        }
    }

    croak
      'Invalid Firefox extension: could not find install.rdf in the .XPI at: '
      . $xpi;
}

1;

__END__

=pod

=encoding UTF-8