r70767 - in /trunk/libsocialtext-wikitest-perl: ./ debian/ debian/patches/ lib/Socialtext/ lib/Socialtext/WikiFixture/ lib/Socialtext/WikiObject/ t/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Mon Mar 7 02:55:05 UTC 2011


Author: jawnsy-guest
Date: Mon Mar  7 02:54:38 2011
New Revision: 70767

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70767
Log:
builds clean, dch -r

Removed:
    trunk/libsocialtext-wikitest-perl/debian/patches/
Modified:
    trunk/libsocialtext-wikitest-perl/Changes
    trunk/libsocialtext-wikitest-perl/META.yml
    trunk/libsocialtext-wikitest-perl/debian/changelog
    trunk/libsocialtext-wikitest-perl/debian/compat
    trunk/libsocialtext-wikitest-perl/debian/control
    trunk/libsocialtext-wikitest-perl/debian/copyright
    trunk/libsocialtext-wikitest-perl/debian/rules
    trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture.pm
    trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Null.pm
    trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Selenese.pm
    trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiObject/TestPlan.pm
    trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiTest.pm
    trunk/libsocialtext-wikitest-perl/t/fixture-selenese.t
    trunk/libsocialtext-wikitest-perl/t/fixture.t
    trunk/libsocialtext-wikitest-perl/t/testplan.t

Modified: trunk/libsocialtext-wikitest-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/Changes?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/Changes (original)
+++ trunk/libsocialtext-wikitest-perl/Changes Mon Mar  7 02:54:38 2011
@@ -1,3 +1,15 @@
+0.07 - Mon Dec  6 17:13:38 PST 2010
+ - added select_and_wait()
+ - moved the start_time variable into the base class
+ - moved the handle_command up into the base class
+ - escape backticks for option names, to allow crazy options
+ - Fix a bug to allow UTF8 characters in regexps - Thanks Takatoshi Kitano
+ - Add the 'include' command to the base fixture
+ - move non-selenium functions into the fixture base class
+ - add a 'set_default' method that is like ||=
+ - Allow handle_command to pass through more than 2 args.
+ - fix a test
+
 0.06 - Thu Jun 21 15:47:13 PDT 2007
  - Fix a bug that prevented testing whether a value was "0"
  - Handle multi-byte characters better - Thanks Takatoshi Kitano

Modified: trunk/libsocialtext-wikitest-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/META.yml?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/META.yml (original)
+++ trunk/libsocialtext-wikitest-perl/META.yml Mon Mar  7 02:54:38 2011
@@ -1,15 +1,18 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         Socialtext-WikiTest
-version:      0.06
-version_from: lib/Socialtext/WikiTest.pm
-installdirs:  site
-requires:
+--- #YAML:1.0
+name:                Socialtext-WikiTest
+version:             0.07
+abstract:            ~
+license:             ~
+author:              
+    - Luke Closs <cpan at 5thplane.com>
+generated_by:        ExtUtils::MakeMaker version 6.44
+distribution_type:   module
+requires:     
     mocked:                        0
     Socialtext::Resting:           0
     Socialtext::Resting::Utils:    0.04
     Test::Exception:               0
     Test::More:                    0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: trunk/libsocialtext-wikitest-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/debian/changelog?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/debian/changelog (original)
+++ trunk/libsocialtext-wikitest-perl/debian/changelog Mon Mar  7 02:54:38 2011
@@ -1,8 +1,20 @@
-libsocialtext-wikitest-perl (0.06-5) UNRELEASED; urgency=low
+libsocialtext-wikitest-perl (0.07-1) unstable; urgency=low
 
+  [ Jonathan Yu ]
+  * New upstream release
+  * Add myself to Uploaders and Copyright
+  * Bump to debhelper compat 8
+  * Standards-Version 3.9.1 (no changes)
+  * Refresh copyright information
+  * Rewrite control description
+  * Email change: Ansgar Burchardt -> ansgar at debian.org
+  * Remove perl 5.12 patch (applied upstream)
+  * Replace POD removal patch with an override
+
+  [ Ansgar Burchardt ]
   * Update my email address.
 
- -- Ansgar Burchardt <ansgar at debian.org>  Mon, 01 Nov 2010 11:17:22 +0100
+ -- Jonathan Yu <jawnsy at cpan.org>  Sun, 06 Mar 2011 22:19:39 -0500
 
 libsocialtext-wikitest-perl (0.06-4) unstable; urgency=low
 

Modified: trunk/libsocialtext-wikitest-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/debian/compat?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/debian/compat (original)
+++ trunk/libsocialtext-wikitest-perl/debian/compat Mon Mar  7 02:54:38 2011
@@ -1,1 +1,1 @@
-7
+8

Modified: trunk/libsocialtext-wikitest-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/debian/control?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/debian/control (original)
+++ trunk/libsocialtext-wikitest-perl/debian/control Mon Mar  7 02:54:38 2011
@@ -1,27 +1,31 @@
 Source: libsocialtext-wikitest-perl
 Section: perl
 Priority: optional
-Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: libmocked-perl, libsocialtext-resting-perl,
- libsocialtext-resting-utils-perl (>= 0.04), libtest-exception-perl,
- perl
+Build-Depends: debhelper (>= 8)
+Build-Depends-Indep: perl,
+ libmocked-perl,
+ libsocialtext-resting-perl,
+ libsocialtext-resting-utils-perl,
+ libtest-exception-perl
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 Uploaders: gregor herrmann <gregoa at debian.org>,
+ Jonathan Yu <jawnsy at cpan.org>,
  Ansgar Burchardt <ansgar at debian.org>
-Standards-Version: 3.8.4
+Standards-Version: 3.9.1
 Homepage: http://search.cpan.org/dist/Socialtext-WikiTest/
 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libsocialtext-wikitest-perl/
 Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/
 
 Package: libsocialtext-wikitest-perl
 Architecture: all
-Depends: ${misc:Depends}, ${perl:Depends}, libmocked-perl,
- libsocialtext-resting-perl, libsocialtext-resting-utils-perl (>= 0.04),
+Depends: ${misc:Depends}, ${perl:Depends},
+ libmocked-perl,
+ libsocialtext-resting-perl,
+ libsocialtext-resting-utils-perl,
  libtest-www-selenium-perl
 Description: module to execute tests defined on wiki pages
- Socialtext::WikiTest executes tests defined on wiki pages.
- .
- Socialtext::WikiFixture is a base class that fetches and parses wiki pages
- using the Socialtext::Resting REST API.  It then tries to execute the
- commands in the wiki tables.  The code for executing the tables should
- be implemented in subclasses.
+ Socialtext::WikiTest is a Perl module that enables a user to execute simple
+ web site test scripts defined on Socialtext wiki pages. Since it is based on
+ the Selenium Remote Control, you can deploy the interface on your computer
+ and watch the screen scroll by, which can be helpful in finding rendering
+ errors.

Modified: trunk/libsocialtext-wikitest-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/debian/copyright?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/debian/copyright (original)
+++ trunk/libsocialtext-wikitest-perl/debian/copyright Mon Mar  7 02:54:38 2011
@@ -1,25 +1,31 @@
 Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
-Maintainer: Luke Closs, <luke.closs at socialtext.com>
+Maintainer: Luke Closs <cpan at 5thplane.com>
 Source: http://search.cpan.org/dist/Socialtext-WikiTest/
 Name: Socialtext-WikiTest
 
-Copyright: 2006, 2007 Luke Closs, <luke.closs at socialtext.com>
+Files: *
+Copyright: 2006-2007, Luke Closs <cpan at 5thplane.com>
 License: Artistic or GPL-1+
 
 Files: debian/*
 Copyright: 2009, Christoph Berg <myon at debian.org>
+ 2009, gregor herrmann <gregoa at debian.org>
+ 2010, Ansgar Burchardt <ansgar at debian.org>
+ 2011, Jonathan Yu <jawnsy at cpan.org>
 License: Artistic or GPL-1+
 
 License: Artistic
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the Artistic License, which comes with Perl.
-    On Debian GNU/Linux systems, the complete text of the Artistic License
-    can be found in `/usr/share/common-licenses/Artistic'
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the Artistic License, which comes with Perl.
+ .
+ On Debian systems, the complete text of the Artistic License can be
+ found in `/usr/share/common-licenses/Artistic'.
 
 License: GPL-1+
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 1, or (at your option)
-    any later version.
-    On Debian GNU/Linux systems, the complete text of the GNU General
-    Public License can be found in `/usr/share/common-licenses/GPL'
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+ .
+ On Debian systems, the complete text of version 1 of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL-1'.

Modified: trunk/libsocialtext-wikitest-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/debian/rules?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/debian/rules (original)
+++ trunk/libsocialtext-wikitest-perl/debian/rules Mon Mar  7 02:54:38 2011
@@ -1,4 +1,11 @@
 #!/usr/bin/make -f
+
+PACKAGE = $(shell dh_listpackages)
+TMP     = $(CURDIR)/debian/$(PACKAGE)
 
 %:
 	dh $@
+
+override_dh_auto_install:
+	dh_auto_install
+	rm $(TMP)/usr/share/man/man3/Socialtext::WikiFixture::Null.3pm

Modified: trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture.pm?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture.pm (original)
+++ trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture.pm Mon Mar  7 02:54:38 2011
@@ -2,6 +2,7 @@
 use strict;
 use warnings;
 use Test::WWW::Selenium;
+use Test::More;
 
 =head1 NAME
 
@@ -9,7 +10,7 @@
 
 =cut
 
-our $VERSION = '0.05';
+our $VERSION = '0.06';
 
 =head1 SYNOPSIS
 
@@ -39,6 +40,7 @@
     bless $self, $class;
 
     $self->init;
+    $self->setup_table_variables;
 
     return $self;
 }
@@ -49,7 +51,7 @@
 
 =cut
 
-sub init {}
+sub init { }
 
 =head2 run_test_table( $table_ref )
 
@@ -60,16 +62,35 @@
 
 sub run_test_table {
     my $self = shift;
-    my $table = shift;
-
-    for my $row (@$table) {
+    $self->{table} = shift;
+
+    while (my $row = $self->_next_row) {
         $row->[0] =~ s/^\s*//;
         next unless $row->[0];
         next if $row->[0] =~ /^\*?command\*?$/i; # header
+
+        _escape_options($row);
         $self->handle_command(@$row);
     }
 
     $self->end_hook;
+}
+
+sub _next_row {
+    my $self = shift;
+    return shift @{ $self->{table} };
+}
+
+sub _escape_options {
+    my $row = shift;
+
+    for my $cell (@$row) {
+        # Trim backticks
+        $cell =~ s/^`(.+)`$/$1/;
+
+        # un-escape backticks
+        $cell =~ s/^\\`(.+)\\`$/`$1`/;
+    }
 }
 
 =head2 end_hook()
@@ -83,11 +104,121 @@
 
 =head2 handle_command( @row )
 
-Run the command.  Subclasses will implement this.
-
-=cut
-
-sub handle_command { die 'Subclass must implement' }
+Run the command.  Subclasses can override this.
+
+=cut
+
+sub handle_command {
+    my $self = shift;
+    my $command = shift;
+    $command =~ s/-/_/g;
+    die "Bad command for the fixture: ($command)\n"
+        unless $self->can($command);
+
+    $self->$command( $self->_munge_options(@_) );
+}
+
+sub _munge_options {
+    my $self = shift;
+
+    my @opts;
+    for (@_) {
+        my $var = defined $_ ? $_ : '';
+        $var =~ s/%%(\w+)%%/exists $self->{$1} ? $self->{$1} : die "Undef var - '$1'"/eg;
+        $var =~ s/\\n/\n/g;
+        push @opts, $var;
+    }
+    return @opts;
+}
+
+=head2 setup_table_variables
+
+Called by init() during object creation.  Use it to set variables 
+usable by commands in the wiki test tables.
+
+=cut
+
+sub setup_table_variables {
+    my $self = shift;
+    $self->{start_time} = time;
+}
+
+=head2 quote_as_regex( $option )
+
+Will convert an option to a regex.  If qr// is around the option text,
+the regex will not be escaped.  Be careful with your regexes.
+
+=cut
+
+sub quote_as_regex {
+    my $self = shift;
+    my $var = shift || '';
+
+    Encode::_utf8_on($var) unless Encode::is_utf8($var);
+    if ($var =~ qr{^qr/(.+?)/([imosx]*)$}) {
+        my $mods = $2 || 's';
+        return eval "qr/$1/$mods";
+    }
+    return qr/\Q$var\E/;
+}
+
+=head2 include( $page_name )
+
+Include the wiki test table from $page_name into the current table.
+
+It's kind of like a subroutine call.
+
+=cut
+
+sub include {
+    my $self      = shift;
+    my $page_name = shift;
+
+    print "# Including wikitest commands from $page_name\n";
+    my $tp = $self->{testplan}->new_testplan($page_name);
+
+    unshift @{ $self->{table} }, @{ $tp->{table} };
+}
+
+=head2 set( $name, $value )
+
+Stores a variable for later use.
+
+=cut
+
+sub set {
+    my ($self, $name, $value, $default) = @_;
+    unless (defined $name and defined $value) {
+        diag "Both name and value must be defined for set!";
+        return;
+    }
+
+    # Don't set the value if the default flag was passed in
+    return if $default and defined $self->{$name};
+
+    $self->{$name} = $value;
+    diag "Set '$name' to '$value'";
+}
+
+=head2 set_default( $name, $value )
+
+Stores a variable for later use, but only if it is not already set.
+
+=cut
+
+sub set_default { shift->set(@_, 1) }
+
+=head2 comment( $comment )
+
+Prints $comment to test output.
+
+=cut
+
+sub comment {
+    my ($self, $comment) = @_;
+    diag '';
+    diag "comment: $comment";
+}
 
 =head1 AUTHOR
 

Modified: trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Null.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Null.pm?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Null.pm (original)
+++ trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Null.pm Mon Mar  7 02:54:38 2011
@@ -23,8 +23,16 @@
 sub handle_command { 
     my $self = shift;
     my $command = shift;
-    print "Null: $command\n" unless $self->{silent};
+
+    if ($self->can($command)) {
+        $self->$command(@_);
+    }
+    else {
+        print "Null: $command\n" unless $self->{silent};
+    }
     $CALLS++;
+    $self->{calls}{$command}++;
+    push @{ $self->{args}{$command} }, \@_;
     die if $command eq 'die';
 }
 

Modified: trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Selenese.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Selenese.pm?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Selenese.pm (original)
+++ trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiFixture/Selenese.pm Mon Mar  7 02:54:38 2011
@@ -4,6 +4,7 @@
 use base 'Socialtext::WikiFixture';
 use Encode;
 use Test::More;
+use Carp qw(croak);
 
 =head1 NAME
 
@@ -65,25 +66,43 @@
             host        => $self->{host},
             port        => $self->{port} || 4444,
             browser_url => $self->{browser_url},
-            browser     => $ENV{selenium_browser} || '*firefox',
+            browser     => $self->{browser}  || $ENV{selenium_browser} || '*firefox',
+            verbose     => $self->{verbose},
         );
         $self->{_started_selenium}++;
     }
     $self->{selenium_timeout} ||= 10000;
 
-    $self->setup_table_variables;
-}
-
-=head2 setup_table_variables
-
-Called by init() during object creation.  Use it to set variables 
-usable by commands in the wiki test tables.
-
-=cut
-
-sub setup_table_variables {
-    my $self = shift;
-    $self->{start_time} = time;
+    $self->remove_selenium_frame if $self->{maximize};
+}
+
+=head2
+
+This removes the selenium frame accross the top so you can see the whole window
+
+=cut
+sub remove_selenium_frame {
+    my $self = shift;
+    my $cnode = "document.body.childNodes[1].childNodes[1]";
+
+    my $sel = $self->{selenium};
+
+    $sel->open('about:blank');
+
+    $sel->get_eval("window.frames[0].resizeTo(screen.width,screen.height)");
+
+    $sel->{browser_start_command} ||= '';
+    if ($sel->{browser_start_command} =~ /^\*(?:chrome|firefox)$/) {
+        $sel->get_eval("$cnode.firstChild.setAttribute('style','display:none')");
+        $sel->get_eval("$cnode.childNodes[2].style.width = screen.width + 'px'");
+        $sel->get_eval("$cnode.childNodes[2].childNodes[1].style.width = screen.width + 'px'");
+    }
+    elsif ($sel->{browser_start_command} =~ /^\*ie/) {
+        my $iframe = 'document.getElementById("myiframe")';
+        $sel->get_eval("$iframe.contentWindow.moveTo(0,0)");
+        $sel->get_eval("$iframe.outerHeight = screen.availHeight");
+        $sel->get_eval("$iframe.outerWidth = screen.availWidth");
+    }
 }
 
 =head2 end_hook()
@@ -110,7 +129,7 @@
     my $self = shift;
     my $sel = $self->{selenium};
     my $command = $self->_munge_command(shift);
-    my ($opt1, $opt2) = $self->_munge_options(@_);
+    my ($opt1, $opt2, @other) = $self->_munge_options(@_);
 
     # Convenience method
     if ($command eq 'text_like' and !$opt2) {
@@ -127,9 +146,10 @@
         }
     }
 
+    Encode::_utf8_on($opt2) unless Encode::is_utf8($opt2);
     # Try to guess _ok methods
     $command .= '_ok' if { map { $_ => 1 } qw(open type) }->{$command};
-    $self->$command($opt1, $opt2);
+    $self->$command($opt1, $opt2, @other);
 }
 
 sub _munge_command {
@@ -152,36 +172,14 @@
     return $command;
 }
 
-sub _munge_options {
-    my $self = shift;
-
-    my @opts;
-    for (@_) {
-        my $var = defined $_ ? $_ : '';
-        $var =~ s/%%(\w+)%%/exists $self->{$1} ? $self->{$1} : 'undef' /eg;
-        $var =~ s/\\n/\n/g;
-        push @opts, $var;
-    }
-    return @opts;
-}
-
-
-=head2 quote_as_regex( $option )
-
-Will convert an option to a regex.  If qr// is around the option text,
-the regex will not be escaped.  Be careful with your regexes.
-
-=cut
-
-sub quote_as_regex {
-    my $self = shift;
-    my $var = shift || '';
-
-    Encode::_utf8_on($var) unless Encode::is_utf8($var);
-    if ($var =~ qr{^qr/(.+?)/$}) {
-        return qr/$1/s;
-    }
-    return qr/\Q$var\E/;
+sub _try_condition {
+    my ($self, $condition, $arg, $timeout) = @_;
+
+    $timeout = $self->{selenium_timeout} unless defined $timeout;
+    $arg =~ s/'/\\'/g;
+
+    my $cmd = "try { $condition('$arg') ? true : false } catch(e) { false }";
+    $self->{selenium}->wait_for_condition_ok($cmd, $timeout);
 }
 
 =head2 click_and_wait()
@@ -190,17 +188,28 @@
 
 =cut
 
-sub click_and_wait {
-    my ($self, $opt1, $opt2) = @_;
+sub click_and_wait { shift->_and_wait('click_ok', @_) }
+
+=head2 select_and_wait()
+
+Selects and waits.
+
+=cut
+
+sub select_and_wait { shift->_and_wait('select_ok', @_) }
+
+sub _and_wait {
+    my ($self, $method, $opt1, $opt2) = @_;
     my $sel = $self->{selenium};
 
     my @args;
     push @args, $opt2 if $opt2;
-    $sel->click_ok($opt1, @args);
-    $sel->wait_for_page_to_load_ok($self->{selenium_timeout}, @args);
+    $sel->$method($opt1, @args);
+    $sel->wait_for_page_to_load_ok($self->{selenium_timeout});
 }
 
 =head2 text_present_like()
+
 
 Search entire body for given text
 
@@ -211,32 +220,36 @@
     $self->{selenium}->text_like('//body', $opt1);
 }
 
-=head2 comment( $comment )
-
-Prints $comment to test output.
-
-=cut
-
-sub comment {
-    my ($self, $comment) = @_;
-    diag '';
-    diag "comment: $comment";
-}
-
-=head2 set( $name, $value )
-
-Stores a variable for later use.
-
-=cut
-
-sub set {
-    my ($self, $name, $value) = @_;
-    unless (defined $name and defined $value) {
-        diag "Both name and value must be defined for set!";
+=head2 store_value( $name, $locator )
+
+Stores an element's value as a variable for later use.
+
+=cut
+
+sub store_value {
+    my ($self, $name, $locator) = @_;
+    unless (defined $name and defined $locator) {
+        diag "Both name and locator must be defined for set!";
         return;
     }
-    $self->{$name} = $value;
-    diag "Set '$name' to '$value'";
+    $self->{$name} = $self->{selenium}->get_value($locator);
+    diag "Set '$name' to '$self->{$name}'";
+}
+
+=head2 store_text( $name, $locator )
+
+Stores an element's text as a variable for later use.
+
+=cut
+
+sub store_text {
+    my ($self, $name, $locator) = @_;
+    unless (defined $name and defined $locator) {
+        diag "Both name and locator must be defined for set!";
+        return;
+    }
+    $self->{$name} = $self->{selenium}->get_text($locator);
+    diag "Set '$name' to '$self->{$name}'";
 }
 
 =head2 print_page()
@@ -251,12 +264,90 @@
     print $self->get_text('//body');
 }
 
+=head2 pause($timeout)
+
+Waits $timeout milliseconds (default: 1 second)
+
+=cut
+
+sub pause {
+    my ($self,$timeout) = @_;
+    $timeout = 1000  unless defined $timeout;
+    $timeout /= 1000;
+    sleep $timeout;
+}
+
+=head2 wait_for_text_present_ok($text, $timeout)
+
+Waits until $text is present in the html source
+
+=cut
+
+sub wait_for_text_present_ok {
+    my $self = shift;
+    $self->_try_condition('selenium.isTextPresent', at _);
+}
+
+=head2 wait_for_element_present_ok($locator, $timeout)
+
+Waits until $locator is present
+
+=cut
+
+sub wait_for_element_present_ok {
+    my $self = shift;
+    $self->_try_condition('selenium.isElementPresent', at _);
+}
+
+=head2 wait_for_element_visible_ok($locator, $timeout)
+
+Waits until $locator is visible
+
+=cut
+
+sub wait_for_element_visible_ok {
+    my $self = shift;
+    $self->_try_condition('selenium.isVisible', at _);
+}
+
+=head2 wait_for_text_not_present_ok($text, $timeout)
+
+Waits until $text is not present in the html source
+
+=cut
+
+sub wait_for_text_not_present_ok {
+    my $self = shift;
+    $self->_try_condition('!selenium.isTextPresent', at _);
+}
+
+=head2 wait_for_element_not_present_ok($locator, $timeout)
+
+Waits until $locator is not present
+
+=cut
+
+sub wait_for_element_not_present_ok {
+    my $self = shift;
+    $self->_try_condition('!selenium.isElementPresent', at _);
+}
+
+=head2 wait_for_element_not_visible_ok($locator, $timeout)
+
+Waits until $locator is not visible
+
+=cut
+
+sub wait_for_element_not_visible_ok {
+    my $self = shift;
+    $self->_try_condition('!selenium.isVisible', at _);
+}
+
 =head2 AUTOLOAD
 
 Any functions not specified are passed to Test::WWW::Selenium
 
 =cut
-
 our $AUTOLOAD;
 sub AUTOLOAD {
     my $name = $AUTOLOAD;

Modified: trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiObject/TestPlan.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiObject/TestPlan.pm?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiObject/TestPlan.pm (original)
+++ trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiObject/TestPlan.pm Mon Mar  7 02:54:38 2011
@@ -87,17 +87,63 @@
     }
 
     my $fixture_class = $self->_fixture || $self->{default_fixture};
-    return unless $self->{table} and $fixture_class;
 
-    unless ($fixture_class =~ /::/) {
-        $fixture_class = "Socialtext::WikiFixture::$fixture_class";
+    if ($self->{table} and $fixture_class) {
+        unless ($fixture_class =~ /::/) {
+            $fixture_class = "Socialtext::WikiFixture::$fixture_class";
+        }
+
+        eval "require $fixture_class";
+        die "Can't load fixture $fixture_class $@\n" if $@;
+
+        $self->_raise_permissions;
+
+        $self->{fixture_args}{testplan} ||= $self;
+        my $fix = $fixture_class->new( %{ $self->{fixture_args} } );
+        $self->{fixture} = $fix;
+        $fix->run_test_table($self->{table});
     }
 
-    eval "require $fixture_class";
-    die "Can't load fixture $fixture_class $@\n" if $@;
+    $self->_check_headers;
+}
 
-    my $fix = $fixture_class->new( %{ $self->{fixture_args} } );
-    $fix->run_test_table($self->{table});
+sub _check_headers {
+    my $self = shift;
+    my $heads = $self->{headings};
+    if ($heads and @$heads) {
+        my $head = $heads->[0];
+        if ($head =~ /^done_testing$/i) {
+            # nothing
+        }
+        elsif ($head =~ /^skip(?:: (.*))?/i) {
+            my $msg = $1 || "Skip!";
+            my $skipped = $self->{$head} || [ 1 ];
+            SKIP: {
+                skip($msg, scalar @$skipped);
+            }
+        }
+        elsif ($head =~ /^todo(?:: (.*))?/i) {
+            local $TODO = $1 || "Unamed";
+            Test::More::fail();
+        }
+        else {
+            die "Stopped at '$head'\n";
+        }
+    }
+}
+
+sub _raise_permissions {
+    my $self = shift;
+    my %browsers = (
+        '*firefox' => '*chrome',
+        '*iexplore' => '*iehta',
+    );
+    my $browser = $self->{fixture_args}{browser};
+    for (@{ $self->{items} || [] }) {
+        if (/^highpermissions$/i and $browsers{$browser}) {
+            $self->{fixture_args}{browser} = $browsers{$browser};
+        }
+    }
 }
 
 # Find the fixture in the page
@@ -117,15 +163,22 @@
         next unless $i =~ /^\[([^\]]+)\]/;
         my $page = $1;
         warn "# Loading test plan $page...\n";
-        my $plan = Socialtext::WikiObject::TestPlan->new(
-            page => $page,
-            rester => $self->{rester},
-            default_fixture => $self->{default_fixture},
-            fixture_args => $self->{fixture_args},
-        );
+        my $plan = $self->new_testplan($page);
         eval { $plan->run_tests };
         ok 0, "Error during test plan $page: $@" if $@;
     }
 }
 
+sub new_testplan {
+    my $self = shift;
+    my $page = shift;
+
+    return Socialtext::WikiObject::TestPlan->new(
+        page => $page,
+        rester => $self->{rester},
+        default_fixture => $self->{default_fixture},
+        fixture_args => $self->{fixture_args},
+    );
+}
+
 1;

Modified: trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiTest.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiTest.pm?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiTest.pm (original)
+++ trunk/libsocialtext-wikitest-perl/lib/Socialtext/WikiTest.pm Mon Mar  7 02:54:38 2011
@@ -8,7 +8,7 @@
 
 =cut
 
-our $VERSION = '0.06';
+our $VERSION = '0.07';
 
 =head1 AUTHOR
 

Modified: trunk/libsocialtext-wikitest-perl/t/fixture-selenese.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/t/fixture-selenese.t?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/t/fixture-selenese.t (original)
+++ trunk/libsocialtext-wikitest-perl/t/fixture-selenese.t Mon Mar  7 02:54:38 2011
@@ -23,16 +23,19 @@
 | confirmation_like | pen? |
 | confirmation_like | qr/pen?/ |
 | clickAndWait | foo | |
+| selectAndWait | foo | bar |
 EOT
     tests => [
         [ open_ok => '/' ],
         [ title_like => qr/\Qmonkey\E/ ],
         [ text_like => ['//body', qr/\Qwater\E/] ],
         [ text_like => ['//body', qr/\Qpen?\E/] ],
-        [ text_like => ['//body', qr/pen?/] ],
+        [ text_like => ['//body', qr/pen?/s] ],
         [ confirmation_like => qr/\Qpen?\E/ ],
-        [ confirmation_like => qr/pen?/ ],
+        [ confirmation_like => qr/pen?/s ],
         [ click_ok => 'foo' ],
+        [ wait_for_page_to_load_ok => 10000 ],
+        [ select_ok => ['foo', 'bar'] ],
         [ wait_for_page_to_load_ok => 10000 ],
     ],
 );
@@ -62,10 +65,10 @@
 
 Variable_interpolation: {
     my $f = Socialtext::WikiFixture::Selenese->new(selenium => 'fake');
+    eval { $f->_munge_options('%%foo%%') };
+    like $@, qr/Undef var - 'foo'/;
+    $f->{foo} = 'bar';
     my @opts = $f->_munge_options('%%foo%%');
-    is_deeply \@opts, ['undef'];
-    $f->{foo} = 'bar';
-    @opts = $f->_munge_options('%%foo%%');
     is_deeply \@opts, ['bar'];
 }
 
@@ -117,36 +120,6 @@
     is $f->quote_as_regex('qr/foo/'), qr/foo/s;
 }
 
-Special_functions: {
-    no warnings qw/redefine once/;
-    my $f = Socialtext::WikiFixture::Selenese->new(selenium => 'fake');
-    my $diag = '';
-    *Socialtext::WikiFixture::Selenese::diag = sub { $diag .= "$_[0]\n" };
-
-    Comment: {
-        $f->comment('foo');
-        is $diag, "\ncomment: foo\n";
-    }
-
-    Set: {
-        $diag = '';
-        $f->set('foo', 'bar');
-        is $diag, "Set 'foo' to 'bar'\n";
-        is $f->{foo}, 'bar';
-    }
-
-    Bad_set: {
-        $diag = '';
-        $f->set('bar');
-        like $diag, qr/Both name and value/;
-        is $f->{bar}, undef;;
-
-        $diag = '';
-        $f->set(undef, 'bar');
-        like $diag, qr/Both name and value/;
-    }
-}
-
 sub sel_fixture_ok {
     my %args = @_;
 
@@ -155,3 +128,43 @@
         %args,
     );
 }
+
+Higher_permissions: {
+    my %browsers = (
+        '*firefox' => '*chrome',
+        '*iexplore' => '*iehta',
+    );
+    while (my ($low,$high) = each %browsers) {
+        for my $on (1, 0) {
+            my $rester = Socialtext::Resting::Mock->new;
+            my $text = join("",
+                "* Fixture: Selenese\n",
+                $on ? "* HighPermissions\n" : "",
+                "| open | / |\n",
+            );
+
+            $rester->put_page('Test Plan', $text);
+
+            my $plan = Socialtext::WikiObject::TestPlan->new(
+                rester => $rester,
+                page => 'Test Plan',
+                fixture_args => {
+                    browser => $low,
+                    host => 'selenium-server',
+                    username => 'testuser',
+                    password => 'password',
+                    browser_url => 'http://server',
+                    workspace => 'foo',
+                },
+            );
+
+            my $wanted = $on ? $high : $low,
+            my $not = $on ? '' : 'not ';
+
+            $plan->run_tests;
+            is  $plan->{fixture}{browser}, 
+                $wanted, 
+                "${not}HighPermissions causes = $wanted",
+        }
+    }
+}

Modified: trunk/libsocialtext-wikitest-perl/t/fixture.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/t/fixture.t?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/t/fixture.t (original)
+++ trunk/libsocialtext-wikitest-perl/t/fixture.t Mon Mar  7 02:54:38 2011
@@ -3,8 +3,10 @@
 use warnings;
 use Test::More qw/no_plan/;
 use Socialtext::Resting::Mock;
+use Socialtext::WikiFixture::TestUtils qw/fixture_ok/;
 use lib 't/lib';
 use Test::WWW::Selenium qw/$SEL/; # mocked
+use Test::Exception;
 
 BEGIN {
     use lib 'lib';
@@ -24,6 +26,183 @@
     );
 
     eval { $plan->run_tests };
-    ok $@;
-}
-
+    like $@, qr/Bad command/;
+}
+
+Page_including: {
+    $rester->put_page('Foo', "| comment | included |\n");
+    $rester->put_page('Foo', "| comment | included |\n");
+    $rester->put_page('Foo', "| comment | included |\n");
+    $rester->put_page('Bar', "| include | Baz |\n");
+    $rester->put_page('Baz', "| comment | included2 |\n");
+    $rester->put_page('Test Plan', <<EOT);
+* Fixture: Null
+| include | Foo |
+| include | Foo |
+| include | Foo |
+| include | Bar |
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'Test Plan',
+    );
+
+    $plan->run_tests;
+    is $plan->{fixture}{calls}{include}, 5;
+    is $plan->{fixture}{calls}{comment}, 4;
+}
+
+Special_functions: {
+    no warnings qw/redefine once/;
+    my $f = Socialtext::WikiFixture->new;
+    my $diag = '';
+    *Socialtext::WikiFixture::diag = sub { $diag .= "$_[0]\n" };
+
+    Comment: {
+        $f->comment('foo');
+        is $diag, "\ncomment: foo\n";
+    }
+
+    Set: {
+        $diag = '';
+        $f->set('foo', 'bar');
+        is $diag, "Set 'foo' to 'bar'\n";
+        is $f->{foo}, 'bar';
+    }
+
+    Using_a_variable: {
+        $diag = '';
+        $rester->put_page('Test Plan', <<'EOT');
+* Fixture: Socialtext::WikiFixture
+| set | mom | linda |
+| comment | Hi, %%mom%% |
+EOT
+        my $plan = Socialtext::WikiObject::TestPlan->new(
+            rester => $rester,
+            page => 'Test Plan',
+        );
+        $plan->run_tests;
+        like $diag, qr/comment: Hi, linda/;
+    }
+
+    Using_missing_variable: {
+        $rester->put_page('Test Plan', <<'EOT');
+* Fixture: Socialtext::WikiFixture
+| comment | Hi, %%mom%% |
+EOT
+        my $plan = Socialtext::WikiObject::TestPlan->new(
+            rester => $rester,
+            page => 'Test Plan',
+        );
+        eval { $plan->run_tests };
+        like $@, qr/Undef var - 'mom'/;
+    }
+
+    Set_default: {
+        $diag = '';
+        $f->set_default('poop', 'bar');
+        is $diag, "Set 'poop' to 'bar'\n";
+        is $f->{poop}, 'bar';
+
+        $diag = '';
+        $f->set_default('poop', 'baz');
+        is $diag, '';
+        is $f->{poop}, 'bar';
+
+        $diag = '';
+        $f->set('poop', 'baz');
+        is $diag, "Set 'poop' to 'baz'\n";
+        is $f->{poop}, 'baz';
+    }
+
+    Bad_set: {
+        $diag = '';
+        $f->set('bar');
+        like $diag, qr/Both name and value/;
+        is $f->{bar}, undef;;
+
+        $diag = '';
+        $f->set(undef, 'bar');
+        like $diag, qr/Both name and value/;
+    }
+}
+
+
+Escaping_options: {
+    my @testcases = (
+        [ '`foo`'   => 'foo' ],
+        [ '\`foo\`' => '`foo`' ],
+    );
+
+    for my $t (@testcases) {
+        $rester->put_page('Foo', <<EOT);
+* Fixture: Null
+| comment | $t->[0] |
+EOT
+        my $plan = Socialtext::WikiObject::TestPlan->new(
+            rester => $rester,
+            page => 'Foo',
+        );
+
+        $plan->run_tests;
+        is_deeply $plan->{fixture}{args}{comment}, [[$t->[1]]];
+        is $plan->{fixture}{calls}{comment}, 1;
+    }
+}
+
+Headers_die: {
+    $rester->put_page('Dier', <<EOT);
+* Fixture: Null
+| comment | pass here |
+^ Die here
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'Dier',
+    );
+
+    dies_ok { $plan->run_tests } "Dies here";
+}
+
+Headers_done_testing: {
+    $rester->put_page('Liver', <<EOT);
+* Fixture: Null
+| comment | pass here |
+^ DONE_TESTING
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'Liver',
+    );
+
+    lives_ok { $plan->run_tests } "Lives here";
+}
+
+Skip_all: {
+    $rester->put_page('Skipper', <<EOT);
+* Fixture: Null
+| comment | pass here |
+^ SKIP: until we've implemented this stuff
+| comment | skip me! |
+| comment | skip me too! |
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'Skipper',
+    );
+    lives_ok { $plan->run_tests } "Skips";
+}
+
+TODO: {
+    $rester->put_page('todos', <<EOT);
+* Fixture: Null
+| comment | pass here |
+^ TODO: This is a todo
+^ TODO: This is another todo
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'todos',
+    );
+    lives_ok { $plan->run_tests } "TODOs";
+}

Modified: trunk/libsocialtext-wikitest-perl/t/testplan.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsocialtext-wikitest-perl/t/testplan.t?rev=70767&op=diff
==============================================================================
--- trunk/libsocialtext-wikitest-perl/t/testplan.t (original)
+++ trunk/libsocialtext-wikitest-perl/t/testplan.t Mon Mar  7 02:54:38 2011
@@ -109,7 +109,7 @@
     
     if ($args{should_die}) {
         eval { $plan->run_tests };
-        ok $@;
+        ok $@, "Dies";
     }
     else {
         $plan->run_tests;




More information about the Pkg-perl-cvs-commits mailing list