注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

gmd20的个人空间

// 编程和生活

 
 
 

日志

 
 

Perl学习参考网址  

2008-10-21 18:24:59|  分类: 程序设计 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

perl的基本函数可以到http://perldoc.perl.org/perl.html 查找

perl的模块下载和帮助可以到http://www.cpan.org/ 查找

===============

perl中的一个奇怪用法,

AutoLoader http://perldoc.perl.org/AutoLoader.html

AutoLoader 可以用来动态加载代码

可以用来拦截模块中函数的调用,修改成调用其他函数。比如

$sel->is_element_present_ok () 函数是没有定义的,但通过自己重写AUTOLOAD方法就可以把它转换成对is_element_present的调用,详细解释上述网址。selnium提供的perl模块的用法实例,红色部分就是把ok结尾的函数调用转换成其他调用的方法,注意eval函数也没用到了。

============================================

package Test::WWW::Selenium;

use strict;
use base qw(WWW::Selenium);
use Carp qw(croak);

our $VERSION = '1.14';

=head1 NAME

Test::WWW::Selenium - Test applications using Selenium Remote Control

=head1 SYNOPSIS

Test::WWW::Selenium is a subclass of WWW::Selenium that provides
convenient testing functions.

    use Test::More tests => 5;
    use Test::WWW::Selenium;

    # Parameters are passed through to WWW::Selenium
    my $sel = Test::WWW::Selenium->new( host => "localhost",
                                        port => 4444,
                                        browser => "*firefox",
                                        browser_url => "http://www.google.com",
                                        default_names => 1,
                                      );

    # use special test wrappers around WWW::Selenium commands:
    $sel->open_ok("http://www.google.com");
    $sel->type_ok( "q", "hello world");
    $sel->click_ok("btnG");
    $sel->wait_for_page_to_load_ok(5000);
    $sel->title_like(qr/Google Search/);

=head1 REQUIREMENTS

To use this module, you need to have already downloaded and started the
Selenium Server. (The Selenium Server is a Java application.)

=head1 DESCRIPTION

This module is a C<WWW::Selenium> subclass providing some methods
useful for writing tests. For each Selenium command (open, click,
type, ...) there is a corresponding <command>_ok method that
checks the return value (open_ok, click_ok, type_ok).

For each Selenium getter (get_title, ...) there are four autogenerated
methods (<getter>_is, <getter>_isnt, <getter>_like, <getter>_unlike)
to check the value of the attribute.

By calling the constructor with default_names set to a true value your
tests will be given a reasonable name should you choose not to provide
one of your own.

=head1 ADDITIONAL METHODS

Test::WWW::Selenium also provides some other handy testing functions
that wrap WWW::Selenium commands:

=over 4

=item get_location

Returns the relative location of the current page. Works with
_is, _like, ... methods.

=back

=cut

use Test::More;
use Test::Builder;

our $AUTOLOAD;

my $Test = Test::Builder->new;
$Test->exported_to(__PACKAGE__);

my %comparator = (
    is       => 'is_eq',
    isnt     => 'isnt_eq',
    like     => 'like',
    unlike   => 'unlike',
);

# These commands don't require a locator
# grep item lib/WWW/Selenium.pm | grep sel | grep \(\) | grep get
my %no_locator = map { $_ => 1 }
                qw(alert confirmation prompt absolute_location location
                   title body_text all_buttons all_links all_fields);

sub AUTOLOAD {
    my $name = $AUTOLOAD;
    $name =~ s/.*:://;
    return if $name eq 'DESTROY';

    my $sub;
    if ($name =~ /(\w+)_(is|isnt|like|unlike)$/i) {
        my $getter = "get_$1";
        my $comparator = $comparator{lc $2};

        # make a subroutine that will call Test::Builder's test methods
        # with selenium data from the getter
        if ($no_locator{$1}) {
            $sub = sub {
                my( $self, $str, $name ) = @_;
                diag "Test::WWW::Selenium running $getter (@_[1..$#_])"
                    if $self->{verbose};
                $name = "$getter, '$str'"
                    if $self->{default_names} and !defined $name;
                no strict 'refs';
                return $Test->$comparator( $self->$getter, $str, $name );
            };
        }
        else {
            $sub = sub {
                my( $self, $locator, $str, $name ) = @_;
                diag "Test::WWW::Selenium running $getter (@_[1..$#_])"
                    if $self->{verbose};
                $name = "$getter, $locator, '$str'"
                    if $self->{default_names} and !defined $name;
                no strict 'refs';
                return $Test->$comparator( $self->$getter($locator), $str, $name );
            };
        }
    }
   elsif ($name =~ /(\w+?)_?ok$/i) {
        my $cmd = $1;

        # make a subroutine for ok() around the selenium command
        $sub = sub {
            my( $self, $arg1, $arg2, $name ) = @_;
            if ($self->{default_names} and !defined $name) {
                $name = $cmd;
                $name .= ", $arg1" if defined $arg1;
                $name .= ", $arg2" if defined $arg2;
            }
            diag "Test::WWW::Selenium running $cmd (@_[1..$#_])"
                    if $self->{verbose};

            local $Test::Builder::Level = $Test::Builder::Level + 1;
            my $rc = '';
            eval { $rc = $self->$cmd( $arg1, $arg2 ) };
            die $@ if $@ and $@ =~ /Can't locate object method/;
            diag($@) if $@;
            return ok( $rc, $name );
        };
    }

    # jump directly to the new subroutine, avoiding an extra frame stack
    if ($sub) {
        no strict 'refs';
        *{$AUTOLOAD} = $sub;
        goto &$AUTOLOAD;
    }
    else {
        # try to pass through to WWW::Selenium
        my $sel = 'WWW::Selenium';
        my $sub = "${sel}::${name}";
        goto &$sub if exists &$sub;
        my ($package, $filename, $line) = caller;
        die qq(Can't locate object method "$name" via package ")
            . __PACKAGE__
            . qq(" (also tried "$sel") at $filename line $line\n);
    }
}

sub new {
    my ($class, %opts) = @_;
    my $default_names = defined $opts{default_names} ?
                            delete $opts{default_names} : 1;
    my $self = $class->SUPER::new(%opts);
    $self->{default_names} = $default_names;
    $self->start;
    return $self;
}

1;

__END__

=head1 AUTHORS

Maintained by Luke Closs <lukec@cpan.org>

Originally by Mattia Barbon <mbarbon@cpan.org>

=head1 LICENSE

Copyright (c) 2006 Luke Closs <lukec@cpan.org>
Copyright (c) 2005,2006 Mattia Barbon <mbarbon@cpan.org>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself

  评论这张
 
阅读(526)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017