Menu
▾
▴
everydevel-opers
|
From: <chr...@us...> - 2006-03-21 23:44:57
|
Revision: 835 Author: chromatic Date: 2006-03-21 15:44:05 -0800 (Tue, 21 Mar 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=835&view=rev Log Message: ----------- Added node classes and tests for all remaining nodes in ecore. Checked inheritance for all node classes. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/user.pm trunk/ebase/t/Node/user.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/container.pm trunk/ebase/lib/Everything/Node/document.pm trunk/ebase/lib/Everything/Node/htmlsnippet.pm trunk/ebase/lib/Everything/Node/image.pm trunk/ebase/lib/Everything/Node/javascript.pm trunk/ebase/lib/Everything/Node/mail.pm trunk/ebase/lib/Everything/Node/nodeletgroup.pm trunk/ebase/lib/Everything/Node/opcode.pm trunk/ebase/lib/Everything/Node/permission.pm trunk/ebase/lib/Everything/Node/restricted_superdoc.pm trunk/ebase/lib/Everything/Node/superdoc.pm trunk/ebase/lib/Everything/Node/symlink.pm trunk/ebase/lib/Everything/Node/themesetting.pm trunk/ebase/t/Node/container.t trunk/ebase/t/Node/document.t trunk/ebase/t/Node/htmlsnippet.t trunk/ebase/t/Node/image.t trunk/ebase/t/Node/javascript.t trunk/ebase/t/Node/mail.t trunk/ebase/t/Node/nodeletgroup.t trunk/ebase/t/Node/opcode.t trunk/ebase/t/Node/permission.t trunk/ebase/t/Node/restricted_superdoc.t trunk/ebase/t/Node/superdoc.t trunk/ebase/t/Node/symlink.t trunk/ebase/t/Node/themesetting.t Property Changed: ---------------- trunk/ebase/lib/Everything/Node/dbtable.pm trunk/ebase/lib/Everything/Node/htmlcode.pm trunk/ebase/lib/Everything/Node/htmlpage.pm trunk/ebase/lib/Everything/Node/location.pm trunk/ebase/lib/Everything/Node/node.pm trunk/ebase/lib/Everything/Node/nodeball.pm trunk/ebase/lib/Everything/Node/nodegroup.pm trunk/ebase/lib/Everything/Node/nodelet.pm trunk/ebase/lib/Everything/Node/nodemethod.pm trunk/ebase/lib/Everything/Node/nodetype.pm trunk/ebase/lib/Everything/Node/setting.pm trunk/ebase/lib/Everything/Node/theme.pm trunk/ebase/lib/Everything/Node/user.pm trunk/ebase/lib/Everything/Node/usergroup.pm trunk/ebase/lib/Everything/Node/workspace.pm trunk/ebase/t/Node/dbtable.t trunk/ebase/t/Node/htmlcode.t trunk/ebase/t/Node/htmlpage.t trunk/ebase/t/Node/location.t trunk/ebase/t/Node/node.t trunk/ebase/t/Node/nodeball.t trunk/ebase/t/Node/nodegroup.t trunk/ebase/t/Node/nodelet.t trunk/ebase/t/Node/nodemethod.t trunk/ebase/t/Node/nodetype.t trunk/ebase/t/Node/setting.t trunk/ebase/t/Node/theme.t trunk/ebase/t/Node/user.t trunk/ebase/t/Node/usergroup.t trunk/ebase/t/Node/workspace.t Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-03-18 01:42:41 UTC (rev 834) +++ trunk/ebase/MANIFEST 2006-03-21 23:44:05 UTC (rev 835) @@ -59,18 +59,31 @@ lib/Everything/HTML/FormObject/VarsTextField.pm lib/Everything/Mail.pm lib/Everything/Node.pm +lib/Everything/Node/container.pm lib/Everything/Node/dbtable.pm +lib/Everything/Node/document.pm lib/Everything/Node/htmlcode.pm lib/Everything/Node/htmlpage.pm +lib/Everything/Node/htmlsnippet.pm +lib/Everything/Node/image.pm +lib/Everything/Node/javascript.pm lib/Everything/Node/location.pm +lib/Everything/Node/mail.pm lib/Everything/Node/node.pm lib/Everything/Node/nodeball.pm lib/Everything/Node/nodegroup.pm lib/Everything/Node/nodelet.pm +lib/Everything/Node/nodeletgroup.pm lib/Everything/Node/nodemethod.pm lib/Everything/Node/nodetype.pm +lib/Everything/Node/opcode.pm +lib/Everything/Node/permission.pm +lib/Everything/Node/restricted_superdoc.pm lib/Everything/Node/setting.pm +lib/Everything/Node/superdoc.pm +lib/Everything/Node/symlink.pm lib/Everything/Node/theme.pm +lib/Everything/Node/themesetting.pm lib/Everything/Node/user.pm lib/Everything/Node/usergroup.pm lib/Everything/Node/workspace.pm @@ -116,18 +129,31 @@ t/lib/MockHandle.pm t/lib/TieOut.pm t/Node.t +t/Node/container.t t/Node/dbtable.t +t/Node/document.t t/Node/htmlcode.t t/Node/htmlpage.t +t/Node/htmlsnippet.t +t/Node/image.t +t/Node/javascript.t t/Node/location.t +t/Node/mail.t t/Node/node.t t/Node/nodeball.t t/Node/nodegroup.t t/Node/nodelet.t +t/Node/nodeletgroup.t t/Node/nodemethod.t t/Node/nodetype.t +t/Node/opcode.t +t/Node/permission.t +t/Node/restricted_superdoc.t t/Node/setting.t +t/Node/superdoc.t +t/Node/symlink.t t/Node/theme.t +t/Node/themesetting.t t/Node/user.t t/Node/usergroup.t t/Node/workspace.t Added: trunk/ebase/lib/Everything/Node/container.pm =================================================================== --- trunk/ebase/lib/Everything/Node/container.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/container.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::container + +Class representing the container node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::container; + +use strict; +use warnings; + +use base 'Everything::Node::node'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/container.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/document.pm =================================================================== --- trunk/ebase/lib/Everything/Node/document.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/document.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::document + +Class representing the document node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::document; + +use strict; +use warnings; + +use base 'Everything::Node::node'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/document.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/htmlsnippet.pm =================================================================== --- trunk/ebase/lib/Everything/Node/htmlsnippet.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/htmlsnippet.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::htmlsnippet + +Class representing the htmlsnippet node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::htmlsnippet; + +use strict; +use warnings; + +use base 'Everything::Node::htmlcode'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/htmlsnippet.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/image.pm =================================================================== --- trunk/ebase/lib/Everything/Node/image.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/image.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::image + +Class representing the image node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::image; + +use strict; +use warnings; + +use base 'Everything::Node::node'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/image.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/javascript.pm =================================================================== --- trunk/ebase/lib/Everything/Node/javascript.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/javascript.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::javascript + +Class representing the javascript node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::javascript; + +use strict; +use warnings; + +use base 'Everything::Node::node'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/javascript.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/mail.pm =================================================================== --- trunk/ebase/lib/Everything/Node/mail.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/mail.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::mail + +Class representing the mail node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::mail; + +use strict; +use warnings; + +use base 'Everything::Node::document'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/mail.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/nodeletgroup.pm =================================================================== --- trunk/ebase/lib/Everything/Node/nodeletgroup.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/nodeletgroup.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::nodeletgroup + +Class representing the nodeletgroup node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::nodeletgroup; + +use strict; +use warnings; + +use base 'Everything::Node::nodegroup'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/nodeletgroup.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/opcode.pm =================================================================== --- trunk/ebase/lib/Everything/Node/opcode.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/opcode.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::opcode + +Class representing the opcode node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::opcode; + +use strict; +use warnings; + +use base 'Everything::Node::htmlcode'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/opcode.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/permission.pm =================================================================== --- trunk/ebase/lib/Everything/Node/permission.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/permission.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::permission + +Class representing the permission node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::permission; + +use strict; +use warnings; + +use base 'Everything::Node::htmlcode'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/permission.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/restricted_superdoc.pm =================================================================== --- trunk/ebase/lib/Everything/Node/restricted_superdoc.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/restricted_superdoc.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::restricted_superdoc + +Class representing the restricted_superdoc node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::restricted_superdoc; + +use strict; +use warnings; + +use base 'Everything::Node::superdoc'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/restricted_superdoc.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/superdoc.pm =================================================================== --- trunk/ebase/lib/Everything/Node/superdoc.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/superdoc.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::superdoc + +Class representing the superdoc node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::superdoc; + +use strict; +use warnings; + +use base 'Everything::Node::document'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/superdoc.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/symlink.pm =================================================================== --- trunk/ebase/lib/Everything/Node/symlink.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/symlink.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::symlink + +Class representing the symlink node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::symlink; + +use strict; +use warnings; + +use base 'Everything::Node::node'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/symlink.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/themesetting.pm =================================================================== --- trunk/ebase/lib/Everything/Node/themesetting.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/themesetting.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,16 @@ +=head1 Everything::Node::themesetting + +Class representing the themesetting node. + +Copyright 2006 Everything Development Inc. + +=cut + +package Everything::Node::themesetting; + +use strict; +use warnings; + +use base 'Everything::Node::setting'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/themesetting.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/user.pm =================================================================== --- trunk/ebase/lib/Everything/Node/user.pm 2006-03-18 01:42:41 UTC (rev 834) +++ trunk/ebase/lib/Everything/Node/user.pm 2006-03-21 23:44:05 UTC (rev 835) @@ -12,7 +12,7 @@ use warnings; use Everything; -use base 'Everything::Node::node'; +use base 'Everything::Node::setting'; =head2 C<insert> Added: trunk/ebase/t/Node/container.t =================================================================== --- trunk/ebase/t/Node/container.t (rev 0) +++ trunk/ebase/t/Node/container.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::container'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::node' ), 'container should extend node' ); Property changes on: trunk/ebase/t/Node/container.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/document.t =================================================================== --- trunk/ebase/t/Node/document.t (rev 0) +++ trunk/ebase/t/Node/document.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::document'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::node' ), 'document should extend node' ); Property changes on: trunk/ebase/t/Node/document.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/htmlsnippet.t =================================================================== --- trunk/ebase/t/Node/htmlsnippet.t (rev 0) +++ trunk/ebase/t/Node/htmlsnippet.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::htmlsnippet'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::htmlcode' ), + 'htmlsnippet should extend htmlcode' ); Property changes on: trunk/ebase/t/Node/htmlsnippet.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/image.t =================================================================== --- trunk/ebase/t/Node/image.t (rev 0) +++ trunk/ebase/t/Node/image.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::image'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::node' ), 'image should extend node' ); Property changes on: trunk/ebase/t/Node/image.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/javascript.t =================================================================== --- trunk/ebase/t/Node/javascript.t (rev 0) +++ trunk/ebase/t/Node/javascript.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::javascript'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::node' ), 'javascript should extend node' ); Property changes on: trunk/ebase/t/Node/javascript.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/mail.t =================================================================== --- trunk/ebase/t/Node/mail.t (rev 0) +++ trunk/ebase/t/Node/mail.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::mail'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::document' ), + 'mail should extend document' ); Property changes on: trunk/ebase/t/Node/mail.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/nodeletgroup.t =================================================================== --- trunk/ebase/t/Node/nodeletgroup.t (rev 0) +++ trunk/ebase/t/Node/nodeletgroup.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::nodeletgroup'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::nodegroup' ), + 'nodeletgroup should extend nodegroup' ); Property changes on: trunk/ebase/t/Node/nodeletgroup.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/opcode.t =================================================================== --- trunk/ebase/t/Node/opcode.t (rev 0) +++ trunk/ebase/t/Node/opcode.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::opcode'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::htmlcode' ), + 'theme should extend htmlcode' ); Property changes on: trunk/ebase/t/Node/opcode.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/permission.t =================================================================== --- trunk/ebase/t/Node/permission.t (rev 0) +++ trunk/ebase/t/Node/permission.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::permission'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::htmlcode' ), + 'permission should extend htmlcode' ); Property changes on: trunk/ebase/t/Node/permission.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/restricted_superdoc.t =================================================================== --- trunk/ebase/t/Node/restricted_superdoc.t (rev 0) +++ trunk/ebase/t/Node/restricted_superdoc.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::restricted_superdoc'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::superdoc' ), + 'restricted_superdoc should extend superdoc' ); Property changes on: trunk/ebase/t/Node/restricted_superdoc.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/superdoc.t =================================================================== --- trunk/ebase/t/Node/superdoc.t (rev 0) +++ trunk/ebase/t/Node/superdoc.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::superdoc'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::document' ), + 'theme should extend document' ); Property changes on: trunk/ebase/t/Node/superdoc.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/symlink.t =================================================================== --- trunk/ebase/t/Node/symlink.t (rev 0) +++ trunk/ebase/t/Node/symlink.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::symlink'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::node' ), 'theme should extend node' ); Property changes on: trunk/ebase/t/Node/symlink.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/t/Node/themesetting.t =================================================================== --- trunk/ebase/t/Node/themesetting.t (rev 0) +++ trunk/ebase/t/Node/themesetting.t 2006-03-21 23:44:05 UTC (rev 835) @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN +{ + chdir 't' if -d 't'; + use lib 'lib'; +} + +use Test::More tests => 2; + +my $module = 'Everything::Node::themesetting'; +use_ok( $module ) or exit; + +ok( $module->isa( 'Everything::Node::setting' ), + 'theme should extend setting' ); Property changes on: trunk/ebase/t/Node/themesetting.t ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/t/Node/user.t =================================================================== --- trunk/ebase/t/Node/user.t 2006-03-18 01:42:41 UTC (rev 834) +++ trunk/ebase/t/Node/user.t 2006-03-21 23:44:05 UTC (rev 835) @@ -17,7 +17,7 @@ my $module = 'Everything::Node::user'; use_ok( $module ) or exit; -ok( $module->isa( 'Everything::Node::node' ), 'user should extend node' ); +ok( $module->isa( 'Everything::Node::setting' ), 'user should extend setting' ); sub AUTOLOAD { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-03-22 00:32:50
|
Revision: 837 Author: chromatic Date: 2006-03-21 16:32:27 -0800 (Tue, 21 Mar 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=837&view=rev Log Message: ----------- Rewrote UNIVERSAL::isa() and UNIVERSAL::can() calls to their method forms. Modified Paths: -------------- trunk/ebase/Build.PL trunk/ebase/lib/Everything/HTML/FormObject/PermissionMenu.pm trunk/ebase/lib/Everything/Mail.pm trunk/ebase/lib/Everything/Node/node.pm trunk/ebase/lib/Everything/Node/nodeball.pm trunk/ebase/lib/Everything/Node/nodegroup.pm trunk/ebase/lib/Everything/NodeBase.pm trunk/ebase/lib/Everything.pm trunk/ebase/t/HTML/Datetime.t trunk/ebase/t/HTML/FormObject/AuthorMenu.t trunk/ebase/t/HTML/FormObject/ListMenu.t trunk/ebase/t/HTML/FormObject/NodetypeMenu.t trunk/ebase/t/NodeBase.t Modified: trunk/ebase/Build.PL =================================================================== --- trunk/ebase/Build.PL 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/Build.PL 2006-03-22 00:32:27 UTC (rev 837) @@ -34,6 +34,7 @@ 'File::Spec' => 0.82, 'Mail::Address' => 1.53, 'Mail::Sender' => 0, + 'Scalar::Util' => 1.01, }, build_requires => { Modified: trunk/ebase/lib/Everything/HTML/FormObject/PermissionMenu.pm =================================================================== --- trunk/ebase/lib/Everything/HTML/FormObject/PermissionMenu.pm 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/lib/Everything/HTML/FormObject/PermissionMenu.pm 2006-03-22 00:32:27 UTC (rev 837) @@ -87,7 +87,7 @@ $this->SUPER::genObject( $query, $bindNode, "${field}:$perm", $name ) . "\n"; - if ( $default eq 'AUTO' && UNIVERSAL::isa( $bindNode, 'Everything::Node' ) ) + if ( $default eq 'AUTO' && eval { $bindNode->isa( 'Everything::Node' ) } ) { my $perms = $bindNode->{$field}; $default = substr( $perms, $masks{$perm}, 1 ); Modified: trunk/ebase/lib/Everything/Mail.pm =================================================================== --- trunk/ebase/lib/Everything/Mail.pm 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/lib/Everything/Mail.pm 2006-03-22 00:32:27 UTC (rev 837) @@ -10,6 +10,7 @@ use Mail::Sender; use Mail::Address; +use Scalar::Util 'reftype'; use Exporter (); use vars qw( $VERSION @ISA @EXPORT ); @@ -28,7 +29,7 @@ $node = getNode($node); return unless $node; - my @addresses = ( UNIVERSAL::isa( $addr, 'ARRAY' ) ? @$addr : $addr ); + my @addresses = ( reftype( $addr ) || '' ) eq 'ARRAY' ? @$addr : $addr; my $body = $node->{doctext} || ''; Everything::logErrors('Sending email with empty body') @@ -88,7 +89,7 @@ # Nothing to do here! return Everything::logErrors('No input files for mail2node!') unless $files; - $files = [$files] unless UNIVERSAL::isa( $files, 'ARRAY' ); + $files = [$files] unless ( reftype( $files ) || '' ) eq 'ARRAY'; my ( $from, $to, $subject, $body ); foreach my $file (@$files) Modified: trunk/ebase/lib/Everything/Node/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/node.pm 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/lib/Everything/Node/node.pm 2006-03-22 00:32:27 UTC (rev 837) @@ -12,10 +12,13 @@ use warnings; use DBI; + use Everything; use Everything::NodeBase; use Everything::XML; +use Scalar::Util 'reftype'; + sub construct { 1 } sub destruct { 1 } @@ -43,7 +46,7 @@ my $node_id = $this->{node_id}; my ( $user_id, %tableData ); - $user_id = $USER->getId() if UNIVERSAL::isa( $USER, 'Everything::Node' ); + $user_id = $USER->getId() if eval { $USER->isa( 'Everything::Node' ) }; $user_id ||= $USER; @@ -431,7 +434,7 @@ { my ( $this, $NODE, $USER ) = @_; - return unless $NODE and UNIVERSAL::isa( $NODE, 'HASH' ); + return unless $NODE and ( reftype( $NODE ) || '' ) eq 'HASH'; my %unique = map { $_ => 1 } qw( title createtime type_nodetype type ); Modified: trunk/ebase/lib/Everything/Node/nodeball.pm =================================================================== --- trunk/ebase/lib/Everything/Node/nodeball.pm 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/lib/Everything/Node/nodeball.pm 2006-03-22 00:32:27 UTC (rev 837) @@ -48,7 +48,7 @@ my $title = 'ROOT'; $title = $user->{title} - if $user && UNIVERSAL::isa( $user, 'Everything::Node' ); + if $user && $user->isa( 'Everything::Node' ); $VARS = { author => $title, Modified: trunk/ebase/lib/Everything/Node/nodegroup.pm =================================================================== --- trunk/ebase/lib/Everything/Node/nodegroup.pm 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/lib/Everything/Node/nodegroup.pm 2006-03-22 00:32:27 UTC (rev 837) @@ -15,7 +15,9 @@ use Everything; use Everything::XML; + use XML::DOM; +use Scalar::Util 'reftype'; sub construct { @@ -501,7 +503,7 @@ return 0 unless $USER and $insert and $this->hasAccess( $USER, 'w' ); # converts to a list reference w/ 1 element if we get a scalar - my $insertref = [$insert] unless UNIVERSAL::isa( $insert, 'ARRAY' ); + my $insertref = [$insert] unless ( reftype( $insert ) || '' eq 'ARRAY' ); $insertref = $this->restrict_type($insertref); @@ -606,7 +608,7 @@ return 0 unless $this->hasAccess( $USER, 'w' ); - $REPLACE = [$REPLACE] unless UNIVERSAL::isa( $REPLACE, 'ARRAY' ); + $REPLACE = [$REPLACE] unless ( reftype( $REPLACE ) || '' ) eq 'ARRAY'; $REPLACE = $this->restrict_type($REPLACE); Modified: trunk/ebase/lib/Everything/NodeBase.pm =================================================================== --- trunk/ebase/lib/Everything/NodeBase.pm 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/lib/Everything/NodeBase.pm 2006-03-22 00:32:27 UTC (rev 837) @@ -70,7 +70,7 @@ my $cacheSize = 300; # Get the settings from the system - if ( defined $CACHE && UNIVERSAL::isa( $CACHE, 'Everything::Node' ) ) + if ( defined $CACHE && $CACHE->isa( 'Everything::Node' ) ) { my $vars = $CACHE->getVars(); $cacheSize = $vars->{maxSize} if exists $vars->{maxSize}; @@ -150,8 +150,8 @@ my $cmpval = sub { my ( $val1, $val2 ) = @_; - $val1 = $val1->{node_id} if UNIVERSAL::isa( $val1, 'Everything::Node' ); - $val2 = $val2->{node_id} if UNIVERSAL::isa( $val2, 'Everything::Node' ); + $val1 = $val1->{node_id} if eval { $val1->isa( 'Everything::Node' ) }; + $val2 = $val2->{node_id} if eval { $val2->isa( 'Everything::Node' ) }; $val1 eq $val2; }; Modified: trunk/ebase/lib/Everything.pm =================================================================== --- trunk/ebase/lib/Everything.pm 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/lib/Everything.pm 2006-03-22 00:32:27 UTC (rev 837) @@ -14,7 +14,9 @@ ############################################################################# use strict; + use DBI; +use Scalar::Util 'reftype'; use vars qw($DB $VERSION); @@ -335,7 +337,7 @@ my ( $db, $options ) = @_; $options = {} unless defined $options - and UNIVERSAL::isa( $options, 'HASH' ); + and (reftype( $options ) || '' ) eq 'HASH'; # Make sure that we clear the warnings/errors for this go around. clearFrontside(); Modified: trunk/ebase/t/HTML/Datetime.t =================================================================== --- trunk/ebase/t/HTML/Datetime.t 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/t/HTML/Datetime.t 2006-03-22 00:32:27 UTC (rev 837) @@ -314,7 +314,7 @@ { my ($subname) = $AUTOLOAD =~ /([^:]+)$/; - if ( my $sub = UNIVERSAL::can( $package, $subname ) ) + if ( my $sub = $package->can( $subname ) ) { $sub->(@_); } Modified: trunk/ebase/t/HTML/FormObject/AuthorMenu.t =================================================================== --- trunk/ebase/t/HTML/FormObject/AuthorMenu.t 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/t/HTML/FormObject/AuthorMenu.t 2006-03-22 00:32:27 UTC (rev 837) @@ -181,7 +181,7 @@ sub AUTOLOAD { my ($subname) = $AUTOLOAD =~ /([^:]+)$/; - if ( my $sub = UNIVERSAL::can( $package, $subname ) ) + if ( my $sub = $package->can( $subname ) ) { $sub->(@_); } Modified: trunk/ebase/t/HTML/FormObject/ListMenu.t =================================================================== --- trunk/ebase/t/HTML/FormObject/ListMenu.t 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/t/HTML/FormObject/ListMenu.t 2006-03-22 00:32:27 UTC (rev 837) @@ -151,7 +151,7 @@ { my ($subname) = $AUTOLOAD =~ /([^:]+)$/; - if ( my $sub = UNIVERSAL::can( $package, $subname ) ) + if ( my $sub = $package->can( $subname ) ) { $sub->(@_); } Modified: trunk/ebase/t/HTML/FormObject/NodetypeMenu.t =================================================================== --- trunk/ebase/t/HTML/FormObject/NodetypeMenu.t 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/t/HTML/FormObject/NodetypeMenu.t 2006-03-22 00:32:27 UTC (rev 837) @@ -265,7 +265,7 @@ { my ($subname) = $AUTOLOAD =~ /([^:]+)$/; - if ( my $sub = UNIVERSAL::can( $package, $subname ) ) + if ( my $sub = $package->can( $subname ) ) { $sub->(@_); } Modified: trunk/ebase/t/NodeBase.t =================================================================== --- trunk/ebase/t/NodeBase.t 2006-03-22 00:18:23 UTC (rev 836) +++ trunk/ebase/t/NodeBase.t 2006-03-22 00:32:27 UTC (rev 837) @@ -285,8 +285,7 @@ $result = getRef( $mock, $first, $second, $third, $u ); is( $first, 'first', 'getRef() should modify references in place' ); is( $second, 'second', '... for all passed in node_ids' ); -ok( UNIVERSAL::isa( $third, 'Everything::Node' ), - '... not mangling existing nodes' ); +ok( $third->isa( 'Everything::Node' ), '... not mangling existing nodes' ); is( $u, undef, '... skipping undefined values' ); is( $result, 'first', '... returning node of first element' ); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-03-29 01:01:59
|
Revision: 838 Author: chromatic Date: 2006-03-28 17:01:44 -0800 (Tue, 28 Mar 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=838&view=rev Log Message: ----------- r14490@windwheel: chromatic | 2006-03-28 16:57:29 -0800 Made Everything::Node::node inherit from Everything::Node. Added a constructor to Everything::Node::node. Fixed the broken setting test due to #1. Started to migrate node tests to Everything::Node::Test and Test::Class. Marked Test::Class as a dependency in Build.PL. Modified Paths: -------------- trunk/ebase/Build.PL trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/node.pm trunk/ebase/t/Node/node.t trunk/ebase/t/Node/setting.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/ trunk/ebase/lib/Everything/Node/Test/node.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:14490 Modified: trunk/ebase/Build.PL =================================================================== --- trunk/ebase/Build.PL 2006-03-22 00:32:27 UTC (rev 837) +++ trunk/ebase/Build.PL 2006-03-29 01:01:44 UTC (rev 838) @@ -38,6 +38,7 @@ }, build_requires => { + 'Test::Class' => 0.11, 'Test::MockObject' => 0.11, 'Test::Exception' => 0.13, 'Test::Simple' => 0.47, Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-03-22 00:32:27 UTC (rev 837) +++ trunk/ebase/MANIFEST 2006-03-29 01:01:44 UTC (rev 838) @@ -87,6 +87,7 @@ lib/Everything/Node/user.pm lib/Everything/Node/usergroup.pm lib/Everything/Node/workspace.pm +lib/Everything/Node/Test/node.pm lib/Everything/Nodeball.pm lib/Everything/NodeBase.pm lib/Everything/NodeBase/mysql.pm Added: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-03-29 01:01:44 UTC (rev 838) @@ -0,0 +1,966 @@ +package Everything::Node::Test::node; + +use strict; +use warnings; + +use base 'Test::Class'; + +use Test::More; +use Test::MockObject; +use Test::MockObject::Extends; + +sub node_class { 'Everything::Node::node' } + +my $module = 'Everything::Node::node'; + +sub startup :Test( startup => 5 ) +{ + my $self = shift; + my $mock = Test::MockObject->new(); + $self->{mock_db} = $mock; + $self->{errors} = \(my @le); + + $mock->fake_module( 'Everything', logErrors => sub { push @le, [@_] } ); + *Everything::Node::node::DB = \$mock; + + my $module = $self->node_class(); + my %import; + + my $mockimport = sub { $import{ +shift }++ }; + + for my $mod (qw( DBI Everything Everything::NodeBase Everything::XML)) + { + $mock->fake_module( $mod, import => $mockimport ); + } + + use_ok( $module ) or exit; + is( keys %import, 4, "$module should use several modules" ); + + ok( $module->isa( 'Everything::Node' ), + "$module should extend Everything::Node" ); + + # now test that C<new()> works + can_ok( $module, 'new' ); + isa_ok( $module->new(), $module ); +} + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $module = $self->node_class(); + can_ok( $module, 'dbtables' ); + my @tables = $module->dbtables(); + is_deeply( \@tables, [ 'node' ], 'dbtables() should return node tables' ); +} + +sub make_fixture :Test(setup) +{ + my $self = shift; + $self->{mock} = Test::MockObject->new(); + my $node = $self->node_class()->new(); + $self->{node} = Test::MockObject::Extends->new( $node ); +} + +sub test_construct :Test( 1 ) +{ + my $self = shift; + ok( $self->{node}->construct(), 'construct() should return true' ); +} + +sub test_destruct :Test( 1 ) +{ + my $self = shift; + ok( $self->{node}->destruct(), 'destruct() should return true' ); +} + +sub test_insert_access :Test( 3 ) +{ + my $self = shift; + my $mock = $self->{mock}; + my $node = $self->{node}; + + $node->set_false( 'hasAccess' ); + is( $node->insert( $mock ), 0, + 'insert() should return 0 if user lacks access' ); + + my ($method, $args) = $node->next_call(); + is( $args->[1], $mock, 'checking for correct user' ); + is( $args->[2], 'c', '... and create access' ); +} + +sub test_insert_restrictions :Test( 2 ) +{ + my $self = shift; + my $mock = $self->{mock}; + my $node = $self->{node}; + + $node->set_true( 'hasAccess' ) + ->set_series( restrictTitle => 0, 1 ); + is( $node->insert( $mock ), 0, + 'insert() should return 0 if node title is restricted' ); + + $node->{node_id} = 5; + is( $node->insert( $mock ), 5, + 'insert() should return node_id if it is positive already' ); +} + +sub test_is_group :Test( 1 ) +{ + ok( ! shift->{node}->isGroup(), 'isGroup() should return false' ); +} + +sub test_get_field_datatype :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->{a_field} = 111; + is( $node->getFieldDatatype( 'a_field' ), 'noderef', + 'getFieldDatatype() should mark node references as "noderef"' ); + + $node->{b_field} = 'foo'; + $node->{cfield} = 112; + is( $node->getFieldDatatype( 'b_field' ), 'literal_value', + '... but references without ids are literal' ); + is( $node->getFieldDatatype( 'bfield' ), 'literal_value', + '... and so are fields without underscores' ); +} + +sub test_has_vars :Test( 1 ) +{ + ok( !shift->{node}->hasVars(), 'hasVars() should return false' ); +} + +# clone() +sub test_clone :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + is( $self->node_class->clone(), undef, + 'clone() should return without a node to clone' ); + is( $node->clone( 'foo' ), undef, '... or a node hash' ); + + # now set a field not to overwrite + $node->{node_id} = 1; + + my $from_hash = + { + test => 'test', + node_id => 2, + type => "don't copy", + title => "don't copy", + createtime => "don't copy", + type_nodetype => "don't copy", + }; + + ok( $node->clone( $from_hash ), + 'clone() should return true with proper args' ); + + is_deeply( $node, { %$node, test => 'test', node_id => 1 }, + 'clone() should copy only necessary fields' ); +} + +sub test_commit_xml_fixes :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_true( 'update' ); + $node->commitXMLFixes(); + + my ( $method, $args ) = $node->next_call(); + is( "$method @$args", "update $node -1 nomodify", + 'commitXMLFixes() should call update() on node' ); +} + +__END__ + +$mock->{node_id} = 0; +$mock->{type} = $mock; +$mock->{restrictdupes} = 1; +$mock->{DB} = $mock; +is( insert( $mock, '' ), + 0, '... and should return 0 if dupes are restricted and exist' ); +is( $mock->next_call(3), 'getId', '... so it must fetch type node_id' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'sqlSelect', '... selecting matching nodes' ); +is( + join( '-', @$args[ 1 .. 4 ] ), + 'count(*)-node-title = ? AND type_nodetype = ?-', + '... counting from node matching title and type' +); +is( join( '-', @{ $args->[5] } ), 'title-5', '... passing title and type' ); + +$mock->{getNode} = [ { key => 'value' } ]; +$mock->{foo} = 11; + +delete $mock->{type}{restrictdupes}; +$mock->set_true('hasAccess')->set_list( getFields => 'foo' ) + ->set_always( getTableArray => ['table'] )->set_series( getNode => 0, {} ) + ->set_always( sqlSelect => 87 )->set_true('sqlInsert') + ->set_always( now => 'now' )->set_always( lastValue => 'lastValue' ) + ->set_true('cache')->clear(); + +$mock->{node_id} = 0; +ok( + defined( $result = insert( $mock, 'user' ) ), + '... but should return node_id if no dupes exist' +); + +( $method, $args ) = $mock->next_call(6); +is( $method, 'sqlInsert', '... inserting base node' ); + +is( $args->[1], 'node', '... into the node table' ); +is_deeply( + $args->[2], + { + -createtime => 'now', + author_user => 'user', + hits => 0, + foo => 11, + }, + '... with the proper fields' +); + +is( $mock->next_call(), 'lastValue', '... fetching node id' ); +is( $mock->next_call(), 'getTableArray', '... and node tables' ); +is( $mock->next_call(), 'getFields', '... and table fields' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'sqlInsert', '... inserting node' ); +is( $args->[1], 'table', '... into proper table' ); +is_deeply( + $args->[2], + { foo => 11, table_id => 'lastValue' }, + '... proper fields' +); + +( $method, $args ) = $mock->next_call(); +is( $method, 'getNode', '... fetching node' ); +is( join( '-', @$args ), "$mock-lastValue-force", '... forcing refresh' ); +is( $mock->next_call(), 'cache', '... and caching node' ); + +# update() +$mock->{node_id} = 87; +$mock->set_series( hasAccess => 0, 1, 1 ) + ->set_series( updateWorkspaced => 77, 0 )->clear() + ->set_true( -canWorkspace ); + +is( update( $mock, 'user' ), + 0, 'update() should return 0 if user lacks write access' ); +( $method, $args ) = $mock->next_call(); +is( $method, 'hasAccess', '... so should check access' ); +is( join( '-', @$args ), "$mock-user-w", '... write access for user' ); + +$mock->{workspace}{nodes}{ $mock->{node_id} } = 1; +$mock->{DB} = $mock; +$mock->{cache} = $mock; +$result = update( $mock, 'user' ); + +( $method, $args ) = $mock->next_call(2); +is( $method, 'updateWorkspaced', + '... should update workspaced node if it is workspaced' ); +is( $args->[1], 'user', '... for user' ); +is( $result, 77, '... and should return the id if it that works' ); + +delete $mock->{workspace}; +$mock->{type} = $mock; +$mock->{boom} = 88; +$mock->{foom} = 99; + +$mock->set_always( getTableArray => [ 'table', 'table2' ] ) + ->set_series( getFields => 'boom', 'foom' ) + ->set_true('incrementGlobalVersion')->set_true('sqlUpdate')->clear(); + +update( $mock, 'user' ); +is( $mock->next_call(2), 'incrementGlobalVersion', + '... incrementing global version in cache' ); +is( $mock->next_call(), 'cache', '... caching node' ); + +$method = $mock->next_call(); +is( $mock->next_call(), 'sqlSelect', + '... updating modified field without flag' ); +is( $method, 'now', '... with current time' ); +is( $mock->next_call(), 'getTableArray', '... fetching type tables' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'getFields', '... fetching thte fields' ); +is( $args->[1], 'table', '... of each table' ); + +( $method, $args ) = $mock->next_call(); +is( "$method $args->[1]", 'sqlUpdate table', '... updating each table' ); +is( keys %{ $args->[2] }, 1, '... with only allowed fields' ); +is( $args->[3], 'table_id = ?', '... for table' ); +is_deeply( $args->[4], [ $mock->{node_id} ], '... with node id' ); + +# nuke() +$mock->set_series( hasAccess => 0, 1 ) + ->set_series( isGroupType => 0, 'table1', 'table2' ) + ->set_series( sqlSelectMany => 0, $mock ) + ->set_always( getTableArray => ['deltable'] )->set_always( getId => 'id' ) + ->set_series( fetchrow => 'group' )->set_series( sqlDelete => (1) x 4 ) + ->set_true('getRef')->set_true('finish')->set_true('removeNode')->clear(); + +$result = nuke( $mock, 'user' ); + +( $method, $args ) = $mock->next_call(); +is( "$method $args->[1]", + 'getRef user', 'nuke() should fetch user node unless it is -1' ); +ok( !$result, '... and should return false if user lacks delete access' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'hasAccess', '... and should check for access' ); +is( join( '-', @$args ), "$mock-user-d", '... delete access for user' ); + +$mock->{dbh} = $mock; +$mock->clear(); +{ + my $gat; + $mock->mock( getAllTypes => sub { $gat++; return ($mock) x 3 } ); + $result = nuke( $mock, -1 ); + ok( $gat, '... should get all nodetypes' ); + $mock->set_false('getAllTypes'); +} + +isnt( $mock->next_call(), 'getRef', + '... and should not get user node if it is -1' ); +( $method, $args ) = $mock->next_call(2); +is( $method, 'sqlDelete', '... should delete links' ); +is( + join( '-', @$args[ 1, 2 ] ), + 'links-to_node=? OR from_node=?', + '... should delete from or to links from links table' +); +is_deeply( $args->[3], [ 'id', 'id' ], '... with bound node id' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'sqlDelete', '... and deleting node revisions' ); +is( + join( '-', @$args[ 1, 2 ] ), + 'revision-node_id = ?', + '... by id from revision' +); +is_deeply( $args->[3], [87], '... with node_id' ); + +is( $mock->next_call(2), 'isGroupType', + '... should check each type is a group node' ); + +( $method, $args ) = $mock->next_call(2); +is( $method, 'sqlSelectMany', '... should check for node' ); +is( + join( '-', @$args[ 1 .. 3 ] ), + 'table1_id-table1-node_id = ?', + '... in group table' +); +is_deeply( $args->[5], [87], '... by node_id' ); + +is( $mock->next_call(3), 'fetchrow', + '... if it exists, should fetch all containing groups' ); +( $method, $args ) = $mock->next_call(3); +is( $method, 'sqlDelete', '... and should delete' ); +is( + join( '-', @$args[ 1 .. 2 ] ), + 'table2-node_id = ?', + '... from table on node_id' +); +is_deeply( $args->[3], [87], '... for node' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'getNode', '... fetching node' ); +is( join( '-', @$args ), "$mock-group", '... for containing group' ); + +is( $mock->next_call(), 'incrementGlobalVersion', '... forcing a reload' ); + +( $method, $args ) = $mock->next_call(); +is( + "$method @$args", + "getTableArray $mock 1", + '... should fetch all tables for node' +); + +( $method, $args ) = $mock->next_call(); +is( $method, 'sqlDelete', '... deleting node' ); +is( join( '-', @$args[ 1, 2 ] ), 'deltable-deltable_id = ?', + '... from tables' ); +is_deeply( $args->[3], ['id'], '... by node_id' ); +is( $mock->next_call(), 'incrementGlobalVersion', + '... should mark node as updated in cache' ); + +( $method, $args ) = $mock->next_call(); +is( "$method @$args", "removeNode $mock $mock", '... uncaching it' ); +is( $mock->{node_id}, 0, '... should reset node_id' ); +ok( $result, '... and return true' ); + +# getNodeKeys() +$mock->clear(); + +my %keys = map { $_ => 1 } + qw( createtime modified hits reputation + lockedby_user locktime lastupdate foo_id bar ); + +$mock->set_always( getNodeDatabaseHash => \%keys )->clear(); + +$result = getNodeKeys($mock); + +is( $mock->next_call(), 'getNodeDatabaseHash', + 'getNodeKeys() should fetch node database keys' ); +is( scalar keys %$result, + 9, '... and should return them unchanged, if not exporting' ); + +$result = getNodeKeys( $mock, 1 ); +ok( !exists $result->{foo_id}, '... should return no uid keys if exporting' ); +is( join( ' ', keys %$result ), + 'bar', '... and should remove non-export keys as well' ); + +# fieldToXML() +{ + local *Everything::Node::node::genBasicTag; + + my @gbt; + *Everything::Node::node::genBasicTag = sub { + push @gbt, [@_]; + return 'tag'; + }; + + $mock->{afield} = 'thisfield'; + is( fieldToXML( $mock, $mock, 'afield' ), + 'tag', 'fieldToXML() should return an XML tag element' ); + is( scalar @gbt, 1, '... and should call genBasicTag()' ); + is( + join( ' ', @{ $gbt[0] } ), + "$mock field afield thisfield", + '... with the correct arguments' + ); + + ok( !fieldToXML( $mock, $mock, 'notafield' ), + '... and should return false if field does not exist' ); + ok( !exists $mock->{notafield}, '... and should not create field' ); +} + +# xmlTag() +$mock->set_series( getTagName => 'badtag', 'field', 'morefield' )->clear(); + +$mock->{title} = 'thistype'; +my $out; +my $errors; +local *Everything::logErrors; +*Everything::logErrors = sub { (undef, $errors) = @_ }; +{ + $result = xmlTag( $mock, $mock ); + is( $mock->next_call(), 'getTagName', 'xmlTag() should fetch tag name' ); + ok( !$result, '... and should return false unless it contains "field"' ); + like( $errors, qr/tag 'badtag'.+'thistype'/, '... logging an error' ); + + local *Everything::XML::parseBasicTag; + my @pbt; + my $parse = { name => 'parsed', parsed => 11 }; + *Everything::XML::parseBasicTag = sub { + push @pbt, [@_]; + return $parse; + }; + + $result = xmlTag( $mock, $mock ); + is( join( ' ', @{ $pbt[0] } ), "$mock node", '... should parse tag' ); + is( $result, undef, '... should return false with no fixes' ); + is( $mock->{parsed}, 11, '... and should set node field to tag value' ); + + $parse->{where} = 1; + $result = xmlTag( $mock, $mock ); + isa_ok( $result, 'ARRAY', '... should return array ref if fixes exist' ); + is( $result->[0], $parse, '... with the fix in the array ref' ); + is( $mock->{parsed}, -1, '... setting node field to -1' ); +} + +# xmlFinal() +$mock->set_series( existingNodeMatches => $mock, 0 ) + ->set_true('updateFromImport')->set_true('insert')->clear(); + +$result = xmlFinal($mock); + +is( $mock->next_call(), 'existingNodeMatches', + 'xmlFinal() should check for a matching node' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'updateFromImport', '... updating node if so' ); +is( join( '+', @$args ), "$mock+$mock+-1", '... for node by superuser' ); +is( $result, $mock->{node_id}, '... returning the node_id' ); + +$mock->clear(); +$result = xmlFinal($mock); + +( $method, $args ) = $mock->next_call(2); +is( "$method $args->[1]", 'insert -1', '... or should insert the node' ); +is( $result, $mock->{node_id}, '... returning the new node_id' ); + +# applyXMLFix() +my $where = { title => 'title', type_nodetype => 'type', field => 'b' }; +my $fix = { where => $where, field => 'fixme' }; + +is( applyXMLFix( $mock, $fix ), + $fix, 'applyXMLFix() should return fix if it has no "fixBy" field' ); + +$fix->{fixBy} = 'fixme'; +is( applyXMLFix( $mock, $fix, 1 ), + $fix, '... or if the field is not set to "node"' ); + +$errors = '' unless defined $errors; +like( + $errors, + qr/handle fix by 'fixme'/, '... and should log error if flag is set' +); + +$fix->{fixBy} = 'node'; + +my @pxw; +$mock->fake_module( + 'Everything::XML', + patchXMLwhere => sub { + push @pxw, [@_]; + return $_[0]; + } +); + +$mock->set_series( getNode => 0, 0, { node_id => 42 } )->clear(); +$errors = ''; +$result = applyXMLFix( $mock, $fix ); +is( $pxw[0][0], $where, '... should try to resolve node' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'getNode', '... should fetch resolved node' ); +is( join( '-', @$args[ 1, 2 ] ), "$where-type", + '... by fix criteria for type' ); + +is( $result, $fix, '... returning the fix if that did not work' ); +is( $errors, '', '... returning no error without flag' ); + +$result = applyXMLFix( $mock, $fix, 1 ); +like( + $errors, + qr/^|Error.+find 'title' of type 'type'.+field b/, + '... and logging an error if flag is set' +); + +$result = applyXMLFix( $mock, $fix ); +is( $mock->{fixme}, 42, '... should set field to found node_id' ); +ok( !$result, '... should return nothing on success' ); + +# getIdentifyingFields() +is( getIdentifyingFields($mock), + undef, 'getIdentifyingFields() should return undef' ); + +# updateFromImport() +delete @$mock{ keys %$mock }; + +$mock->set_series( getNodeKeys => { foo => 1, bar => 2, baz => 3 } ) + ->set_series( getNodeKeepKeys => { bar => 1 } )->clear(); + +updateFromImport( $mock, { foo => 1, bar => 2, baz => 3 }, 'user' ); +( $method, $args ) = $mock->next_call(); +is( + "$method @$args", + "getNodeKeys $mock 1", + 'updateFromImport() should fetch node keys' +); +is( $mock->next_call(), 'getNodeKeepKeys', '... and keys to keep' ); +is( $mock->{foo} + $mock->{baz}, 4, '... should merge node keys' ); +ok( !exists $mock->{bar}, '... but not those that should be kept' ); +( $method, $args ) = $mock->next_call(); +is( + "$method @$args", + "update $mock user nomodify", + '... and should update node' +); +is( $mock->{modified}, 0, '... and should set "modified" to 0' ); + +# conflictsWith() +$mock->{modified} = ''; +ok( !conflictsWith($mock), + 'conflictsWith() should return false with no digit in "modified" field' ); + +$mock->{modified} = 1; + +my $keep = { foo => 1 }; +my $conflict = { foo => 1, bar => 2 }; + +$mock->set_series( getNodeKeys => $mock, $mock ) + ->set_series( getNodeKeepKeys => $keep, {} )->clear(); + +$mock->{foo} = 1; +$mock->{bar} = 3; +$result = conflictsWith( $mock, $conflict ); +( $method, $args ) = $mock->next_call(); +is( "$method @$args", "getNodeKeys $mock 1", '... and should fetch node keys' ); +is( $mock->next_call(), 'getNodeKeepKeys', '... and keepable keys' ); + +ok( $result, '... should return true if any node field conflicts' ); + +$mock->{bar} = 2; +ok( !conflictsWith( $mock, $conflict ), '... false otherwise' ); + +$mock->{foo} = 2; +ok( !conflictsWith( $mock, $conflict ), '... and should ignore keepable keys' ); + +# getNodeKeepKeys() +$result = getNodeKeepKeys($mock); +isa_ok( $result, 'HASH', 'getNodeKeepKeys() should return a hash reference' ); +foreach my $class (qw( author group other guest )) +{ + ok( $result->{"${class}access"}, "... and should contain $class access" ); + ok( + $result->{"dynamic${class}_permission"}, + "... and $class permission keys" + ); +} +ok( $result->{loc_location}, '... and location key' ); + +# verifyFieldUpdate() +my @fields; +foreach my $field ( + 'createtime', 'node_id', + 'type_nodetype', 'hits', + 'loc_location', 'reputation', + 'lockedby_user', 'locktime', + 'authoraccess', 'groupaccess', + 'otheraccess', 'guestaccess', + 'dynamicauthor_permission', 'dynamicgroup_permission', + 'dynamicother_permission', 'dynamicguest_permission' + ) +{ + push @fields, $field unless verifyFieldUpdate( $mock, $field ); +} + +is( scalar @fields, + 16, 'verifyFieldUpdate() should return false for unmodifiable fields' ); +ok( + !verifyFieldUpdate( $mock, 'foo_id' ), + '... and for primary key (uid) fields' +); +ok( verifyFieldUpdate( $mock, 'agoodkey' ), + '... but true for everything else' ); + +# getRevision() +$mock->{node_id} = 11; +$mock->{DB} = $mock; +$mock->{workspace}{node_id} = 7; +$mock->set_series( sqlSelect => 0, 'xml' ) + ->set_series( sqlSelectHashref => 0, { xml => 'myxml' } )->clear(); + +is( getRevision( $mock, '' ), + 0, 'getRevision() should return 0 if revision is not numeric' ); + +{ + local *Everything::Node::node::xml2node; + *Everything::Node::node::xml2node = sub { [] }; + $result = getRevision( $mock, 0 ); +} + +( $method, $args ) = $mock->next_call(); +is( $method, 'sqlSelectHashref', '... should fetch revision from database' ); + +is( $args->[5][2], 7, '... using workspace id, if it exists' ); +is( $result, 0, '... should return 0 if fetch fails' ); + +delete $mock->{workspace}; +@fields = qw( node_id createtime reputation ); +@$mock{@fields} = (8) x 3; +my @x2n; +{ + local *Everything::Node::node::xml2node; + *Everything::Node::node::xml2node = sub { + push @x2n, [@_]; + return [ { x2n => 1 } ]; + }; + + $result = getRevision( $mock, 1 ); +} + +( $method, $args ) = $mock->next_call(); +is( $method, 'sqlSelectHashref', '... should select the node revision' ); +is( + join( '-', @$args[ 1 .. 3 ], @{ $args->[5] } ), + '*-revision-node_id = ? and revision_id = ? and inside_workspace = ?-8-1-0', + '... using 0 with no workspace' +); +is( join( ' ', @{ $x2n[0] } ), 'myxml noupdate', + '... should xml-ify revision' ); + +is( $result->{x2n}, 1, '... returning the revised node' ); +is( "@$mock{@fields}", "@$result{@fields}", + '... and should copy node_id, createtime, and reputation fields' ); + +# logRevision() +$mock->set_series( hasAccess => 0, (1) x 3 )->set_series( getId => 'id' ) + ->set_series( getNode => $mock ) + ->set_series( sqlSelect => 0, [ 2, 1, 4 ], 0, [] )->clear(); + +is( logRevision( $mock, 'user' ), + 0, 'logRevision() should return 0 if user lacks write access' ); +( $method, $args ) = $mock->next_call(); +is( $method, 'hasAccess', '... so should check for it' ); +is( join( ' ', @$args[ 1, 2 ] ), 'user w', '... write access for user' ); + +delete $mock->{DB}{workspace}; +$mock->{type}{maxrevisions} = 0; + +$result = logRevision( $mock, 'user' ); +is( $result, 0, '... should return 0 if lacking max revisons' ); + +$mock->set_true('toXML')->set_always( getId => 1 )->clear(); + +$mock->{type}{maxrevisions} = -1; +$mock->{type}{derived_maxrevisions} = 1; + +$result = logRevision( $mock, 'user' ); +( $method, $args ) = $mock->next_call(6); +is( $method, 'sqlSelect', '... should fetch data' ); +is( + join( '-', @$args[ 1 .. 4 ] ), + 'max(revision_id)+1-revision-node_id = ? and inside_workspace = ?-', + '... max revision from revision table' +); +is( join( '-', @{ $args->[5] } ), '8-0', '... for node_id and workspace' ); + +( $method, $args ) = $mock->next_call(2); +is( "$method $args->[1]", 'sqlInsert revision', '... inserting new revision' ); +is( $args->[2]{revision_id}, 1, '... using revision id of 1 if necessary' ); + +( $method, $args ) = $mock->next_call(); +like( + "$method @$args", + qr/sqlSelect.+count.+min.+max.+revision/, + '... should fetch max, min, and total revisions' +); +( $method, $args ) = $mock->next_call(); +like( + "$method @$args", + qr/sqlDelete.+revision.+revision_id = /, + '... should delete oldest revision if in workspace and at max limit' +); + +is( $result, 4, '... should return id of newest revision' ); + +$mock->{workspace}{node_id} = $mock->{node_id} = 44; +$mock->{workspace}{nodes}{44} = 'R'; + +$mock->clear(); +logRevision( $mock, 'user' ); +( $method, $args ) = $mock->next_call(2); +is( $method, 'sqlDelete', '... undoing a later revision if in workspace' ); +is( + join( '-', @$args[ 1, 2 ] ), + 'revision-node_id = ? and revision_id > ? and inside_workspace = ?', + '... by node, revision, and workspace' +); +is_deeply( $args->[3], [ 44, 'R', 44 ], '... with the correct values' ); +is( $mock->next_call(), 'toXML', '... and should XMLify node for workspace' ); + +# undo() +$mock->{workspace} = $mock; +$mock->set_series( hasAccess => 0, (1) x 7 ) + ->set_series( sqlSelectMany => ($mock) x 6 ) + ->set_series( fetchrow => ( 1, 5, 0 ) x 6 )->clear(); + +is( undo( $mock, 'uS' ), + 0, 'undo() should return 0 if user lacks write access' ); +( $method, $args ) = $mock->next_call(); +is( $method, 'hasAccess', '... so should call hasAccess()' ); +is( join( '-', @$args[ 1, 2 ] ), 'uS-w', '... read access for user' ); + +$mock->{node_id} = 13; +delete $mock->{workspace}{nodes}{13}; +is( undo( $mock, '' ), + 0, '... returning 0 unless workspace contains this node' ); + +$mock->set_true('setVars')->clear(); +my $position = \$mock->{workspace}{nodes}{13}; +$$position = 4; +$result = undo( $mock, 'user', 1, 1 ); + +( $method, $args ) = $mock->next_call(2); +is( $method, 'sqlSelectMany', '... selecting many rows' ); +is( + join( '-', @$args[ 1 .. 3 ] ), + 'revision_id-revision-node_id = ? and inside_workspace = ?', + '... should fetch revision_ids for node in workspace' +); +is_deeply( $args->[5], [ 13, 13 ], '... for node and revision id' ); + +is( $result, 1, + '... should return true if testing/redoing and revision exists for pos' ); +is( undo( $mock, 'user', 0, 1 ), + 1, '... or if undoing and position is one or more' ); + +$$position = 0; +is( undo( $mock, 'user', 0, 0 ), 0, '... otherwise false' ); + +$$position = 1; +is( undo( $mock, 'user', 1, 0 ), + 0, + '... should return false if redoing and revision does not exist for pos' ); + +$$position = 0; +is( undo( $mock, 'user', 0, 0 ), + 0, '... or if undoing and position is not one or more' ); + +$$position = 1; +$mock->clear(); + +$result = undo( $mock, 'user', 0, 0 ); +is( $mock->{workspace}{nodes}{13}, + 0, '... should update position in workspace for node' ); + +( $method, $args ) = $mock->next_call(6); + +is( $method, 'setVars', '... should set variables' ); +is( $args->[1], $mock->{workspace}{nodes}, '... in workspace' ); +( $method, $args ) = $mock->next_call(); +is( $method, 'update', '... updating workspace' ); +is( $args->[1], 'user', '... for user' ); +ok( $result, '... returning true' ); + +delete $mock->{workspace}; + +my $rev = {}; +$mock->set_series( hasAccess => (1) x 6 ) + ->set_series( sqlSelectHashref => 0, ($rev) x 5 )->clear(); + +$result = undo( $mock, 'user', 0, 0 ); +( $method, $args ) = $mock->next_call(2); +is( $method, 'sqlSelectHashref', '... fetching data' ); +like( + join( ' ', @$args ), + qr/\* revision .+_id=13.+BY rev.+DESC/, + '... if not in workspace, should fetch revision for node' +); +ok( !$result, '... should return false unless found' ); + +$rev->{revision_id} = 1; +ok( !undo( $mock, 'user', 1 ), + '... or false if redoing and revision_id is positive' ); + +$rev->{revision_id} = 0; +ok( !undo( $mock, 'user', 1 ), '... or zero' ); + +$rev->{revision_id} = -1; +ok( !undo( $mock, 'user', 0 ), + '... or false if undoing and revision_id is negative' ); + +$rev->{revision_id} = 77; +ok( undo( $mock, 'user', 0, 1 ), '... or true if testing' ); + +$mock->clear(); +{ + local *Everything::Node::node::xml2node; + *Everything::Node::node::xml2node = sub { [] }; + $result = undo( $mock, 'user' ); +} +is( $mock->next_call(3), 'toXML', '... should XMLify node' ); +is( $rev->{revision_id}, -77, '... should invert revision' ); + +( $method, $args ) = $mock->next_call(); +is( $method, 'sqlUpdate', '... should update database' ); +is( + join( '-', @$args[ 1, 3 ] ), + 'revision-node_id = ? and inside_workspace = ? and revision_id = ?', + '... with new revision' +); +is_deeply( $args->[4], [ 13, 0, 77 ], '... for node, workspace, and revision' ); + +# canWorkspace() +my $ws = $mock->{type} = { canworkspace => 1 }; + +ok( Everything::Node::node::canWorkspace($mock), + 'canWorkspace() should return true if nodetype can be workspaced' ); + +$ws->{canworkspace} = 0; +ok( !canWorkspace($mock), '... and false if it cannot' ); + +$ws->{canworkspace} = -1; +$ws->{derived_canworkspace} = 0; +ok( !canWorkspace($mock), '... or false if inheriting and parent cannot' ); +$ws->{derived_canworkspace} = 1; +ok( canWorkspace($mock), + '... and true if inheriting and parent can workspace' ); + +# getWorkspaced() +$mock->set_series( canWorkspace => 0, 1, 1, 1 ) + ->set_series( getRevision => 'rev', 0 )->clear(); + +ok( !getWorkspaced($mock), + 'getWorkspaced() should return unless node can be workspaced' ); +$mock->{node_id} = 77; +$mock->{workspace} = { + nodes => { + 77 => 44, + 88 => 11, + }, + cached_nodes => { '77_44' => 88, }, +}; +is( getWorkspaced($mock), 88, + '... should return cached node version if it exists' ); +$mock->{node_id} = 88; + +$mock->clear(); +$result = getWorkspaced($mock); +( $method, $args ) = $mock->next_call(2); +is( "$method $args->[1]", 'getRevision 11', '... should fetch revision' ); + +is( $result, 'rev', '... returning it if it exists' ); +is( $mock->{workspace}{cached_nodes}{'88_11'}, + 'rev', '... and should cache it' ); + +$mock->{node_id} = 4; +ok( !getWorkspaced($mock), '... or false otherwise' ); + +# updateWorkspaced() +$mock->set_series( canWorkspace => 0, 1 )->set_series( logRevision => 17 ); + +ok( !updateWorkspaced($mock), + 'updateWorkspaced() should return false unless node can be workspaced' ); + +$mock->clear(); +$mock->{workspace} = $mock; +$mock->{cache} = $mock; +$mock->{node_id} = 41; +$result = updateWorkspaced( $mock, 'user' ); +( $method, $args ) = $mock->next_call(2); +is( $method, 'logRevision', '... should log revision' ); +is( $args->[1], 'user', '... for user' ); +is( $mock->{workspace}{nodes}{41}, 17, '... should log revision in workspace' ); + +( $method, $args ) = $mock->next_call(); +is( + "$method $args->[1]", + "setVars $mock->{workspace}{nodes}", + '... should update variables for workspace' +); +( $method, $args ) = $mock->next_call(); +is( "$method $args->[1]", 'update user', '... updating workspace node' ); + +( $method, $args ) = $mock->next_call(); +is( "$method $args->[1]", "removeNode $mock", '... removing node from cache' ); +is( $result, 41, '... and should return node_id' ); + +# restrictTitle() +ok( !restrictTitle( { foo => 1 } ), + 'restrictTitle() with no title field should return false' ); + +ok( + !restrictTitle( { title => '[foo]' } ), + '... or if title contains a square bracket' +); + +ok( !restrictTitle( { title => 'f>o<o' } ), '... or an angle bracket' ); + +{ + local *Everything::logErrors; + *Everything::logErrors = sub { $errors = shift }; + ok( !restrictTitle( { title => 'o|o' } ), '... or a pipe' ); +} +like( $errors, qr/node.+invalid characters/, '... and should log error' ); + +ok( + restrictTitle( { title => 'a good name zz9' } ), + '... but should return true otherwise' +); +} Property changes on: trunk/ebase/lib/Everything/Node/Test/node.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/node.pm 2006-03-22 00:32:27 UTC (rev 837) +++ trunk/ebase/lib/Everything/Node/node.pm 2006-03-29 01:01:44 UTC (rev 838) @@ -11,14 +11,21 @@ use strict; use warnings; +use base 'Everything::Node'; + use DBI; - use Everything; +use Everything::XML; use Everything::NodeBase; -use Everything::XML; use Scalar::Util 'reftype'; +sub new +{ + my $class = shift; + bless {}, $class; +} + sub construct { 1 } sub destruct { 1 } @@ -58,7 +65,6 @@ if ( $this->{type}{restrictdupes} ) { - # Check to see if we already have a node of this title. my $id = $this->{type}->getId(); Modified: trunk/ebase/t/Node/node.t =================================================================== --- trunk/ebase/t/Node/node.t 2006-03-22 00:32:27 UTC (rev 837) +++ trunk/ebase/t/Node/node.t 2006-03-29 01:01:44 UTC (rev 838) @@ -3,6 +3,13 @@ use strict; use warnings; +=cut + +use Everything::Node::Test::node; +Test::Class->runtests(); + +=cut + use vars '$AUTOLOAD'; BEGIN Modified: trunk/ebase/t/Node/setting.t =================================================================== --- trunk/ebase/t/Node/setting.t 2006-03-22 00:32:27 UTC (rev 837) +++ trunk/ebase/t/Node/setting.t 2006-03-29 01:01:44 UTC (rev 838) @@ -76,8 +76,9 @@ *fieldToXML = \&Everything::Node::setting::fieldToXML; - $node->set_always( getVars => { a => 1, b => 1, c => 1 } ); - $node->set_series( SUPER => 2, 10 ); + $node->set_always( getVars => { a => 1, b => 1, c => 1 } ) + ->set_series( SUPER => 2, 10 ) + ->set_true( '-appendChild' ); is( $node->fieldToXML( '', '', '!' ), This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-03-30 23:51:17
|
Revision: 839 Author: chromatic Date: 2006-03-30 15:51:07 -0800 (Thu, 30 Mar 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=839&view=rev Log Message: ----------- r14510@windwheel: chromatic | 2006-03-30 15:50:49 -0800 Continued porting Everything::Node::node test to Test::Class. Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/node.pm trunk/ebase/lib/Everything/Node/node.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:14490 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:14510 Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-03-29 01:01:44 UTC (rev 838) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-03-30 23:51:07 UTC (rev 839) @@ -9,6 +9,8 @@ use Test::MockObject; use Test::MockObject::Extends; +use Scalar::Util 'reftype'; + sub node_class { 'Everything::Node::node' } my $module = 'Everything::Node::node'; @@ -104,6 +106,33 @@ 'insert() should return node_id if it is positive already' ); } +sub test_insert_restrict_dupes :Test( 2 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $node->{node_id} = 0; + $node->{type} = $node; + $node->{restrictdupes} = 1; + $node->{DB} = $db; + $node->set_true(qw( hasAccess restrictTitle getId )) + ->set_always( getTableArray => [] ); + $db->set_series( sqlSelect => 1, 0 ) + ->set_always( getFields => 'none' ) + ->set_always( now => '' ) + ->set_always( getNode => undef ) + ->set_true( 'sqlInsert' ) + ->set_always( lastValue => 100 ); + + is( $node->insert( '' ), 0, + 'insert() should return 0 if dupes are restricted and exist' ); + + $node->{restrictdupes} = 0; + + is( $node->insert( '' ), 100, + '... or should return the inserted node_id otherwise' ); +} + sub test_is_group :Test( 1 ) { ok( ! shift->{node}->isGroup(), 'isGroup() should return false' ); @@ -172,35 +201,227 @@ 'commitXMLFixes() should call update() on node' ); } -__END__ +sub test_restrict_title :Test( 6 ) +{ + my $self = shift; + my $node = $self->{node}; + delete $node->{title}; -$mock->{node_id} = 0; -$mock->{type} = $mock; -$mock->{restrictdupes} = 1; -$mock->{DB} = $mock; -is( insert( $mock, '' ), - 0, '... and should return 0 if dupes are restricted and exist' ); -is( $mock->next_call(3), 'getId', '... so it must fetch type node_id' ); + ok( ! $node->restrictTitle(), + 'restrictTitle() called with no title field should return false' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'sqlSelect', '... selecting matching nodes' ); -is( - join( '-', @$args[ 1 .. 4 ] ), - 'count(*)-node-title = ? AND type_nodetype = ?-', - '... counting from node matching title and type' -); -is( join( '-', @{ $args->[5] } ), 'title-5', '... passing title and type' ); + $node->{title} = '[foo]'; + ok( ! $node->restrictTitle(), + '... or if title contains a square bracket' + ); -$mock->{getNode} = [ { key => 'value' } ]; -$mock->{foo} = 11; + $node->{title} = 'f>o<o'; + ok( ! $node->restrictTitle(), '... or an angle bracket' ); -delete $mock->{type}{restrictdupes}; -$mock->set_true('hasAccess')->set_list( getFields => 'foo' ) - ->set_always( getTableArray => ['table'] )->set_series( getNode => 0, {} ) - ->set_always( sqlSelect => 87 )->set_true('sqlInsert') - ->set_always( now => 'now' )->set_always( lastValue => 'lastValue' ) - ->set_true('cache')->clear(); + my $errors; + { + local *Everything::logErrors; + *Everything::logErrors = sub { $errors = shift }; + $node->{title} = 'o|o'; + ok( ! $node->restrictTitle(), '... or a pipe' ); + } + like( $errors, qr/node.+invalid characters/, '... and should log error' ); + $node->{title} = 'a good name zz9'; + ok( $node->restrictTitle(), '... but should return true otherwise' ); +} + +sub test_get_node_keep_keys :Test( 10 ) +{ + my $self = shift; + my $node = $self->{node}; + + my $result = $node->getNodeKeepKeys(); + is( reftype( $result ), 'HASH', + 'getNodeKeepKeys() should return a hash reference' ); + + for my $class (qw( author group other guest )) + { + ok( exists $result->{"${class}access"}, + "... and should contain $class access" ); + ok( exists $result->{"dynamic${class}_permission"}, + "... and $class permission keys" ); + } + ok( exists $result->{loc_location}, '... and location key' ); +} + +sub test_get_node_keys :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + + my %keys = map { $_ => 1 } + qw( createtime modified hits reputation + lockedby_user locktime lastupdate foo_id bar ); + + $node->set_always( getNodeDatabaseHash => \%keys ); + + my $result = $node->getNodeKeys(); + + is( $node->next_call(), 'getNodeDatabaseHash', + 'getNodeKeys() should fetch node database keys' ); + is( keys %$result, 9, + '... and should return them unchanged, if not exporting' ); + + $result = $node->getNodeKeys( 1 ); + ok( ! exists $result->{foo_id}, '... returning no uid keys if exporting' ); + is( join( ' ', keys %$result ), 'bar', + '... and removing non-export keys as well' ); +} + +sub test_field_to_XML :Test( 5 ) +{ + my $self = shift; + my $node = $self->{node}; + my @gbt; + + local *Everything::Node::node::genBasicTag; + + *Everything::Node::node::genBasicTag = sub { + push @gbt, [@_]; + return 'tag'; + }; + + $node->{afield} = 'thisfield'; + is( $node->fieldToXML( $node, 'afield' ), 'tag', + 'fieldToXML() should return an XML tag element' ); + is( @gbt, 1, '... and should call genBasicTag()' ); + is( join( ' ', @{ $gbt[0] } ), "$node field afield thisfield", + '... with the correct arguments' ); + + ok( ! $node->fieldToXML( $node, 'notafield' ), + '... and should return false if field does not exist' ); + ok( ! exists $node->{notafield}, '... and should not create field' ); +} + +sub test_get_identifying_fields :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; + is( $node->getIdentifyingFields(), undef, + 'getIdentifyingFields() should return undef' ); +} + +sub test_update_from_import :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->set_true( 'update' ) + ->set_series( -getNodeKeys => { foo => 1, bar => 2, baz => 3 } ) + ->set_series( -getNodeKeepKeys => { bar => 1 } ); + + $node->updateFromImport( { foo => 1, bar => 2, baz => 3 }, 'user' ); + + is( $node->{foo} + $node->{baz}, 4, + 'getNodeKeys() should merge node keys' ); + + ok( ! exists $node->{bar}, '... but not those it should keep' ); + my ( $method, $args ) = $node->next_call(); + is( "$method @$args", "update $node user nomodify", + '... and should update node' ); + is( $node->{modified}, 0, '... setting "modified" to 0' ); +} + +sub test_xml_final :Test( 6 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_series( existingNodeMatches => $node, 0 ) + ->set_true('updateFromImport') + ->set_true('insert'); + + my $result = $node->xmlFinal(); + + is( $node->next_call(), 'existingNodeMatches', + 'xmlFinal() should check for a matching node' ); + + my ( $method, $args ) = $node->next_call(); + is( $method, 'updateFromImport', '... updating node if so' ); + is( join( '+', @$args ), "$node+$node+-1", '... for node by superuser' ); + is( $result, $node->{node_id}, '... returning the node_id' ); + + $result = $node->xmlFinal(); + + ( $method, $args ) = $node->next_call(2); + is( "$method $args->[1]", 'insert -1', '... or should insert the node' ); + is( $result, $node->{node_id}, '... returning the new node_id' ); +} + +sub test_conflicts_with :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->{modified} = ''; + + ok( ! $node->conflictsWith(), + 'conflictsWith() should return false with no digit in "modified"' ); + + $node->{modified} = 1; + + my $keep = { foo => 1 }; + my $conflict = { foo => 1, bar => 2 }; + + $node->set_series( getNodeKeys => $node, $node ) + ->set_series( getNodeKeepKeys => $keep, {} ); + + $node->{foo} = 1; + $node->{bar} = 3; + + my $result = $node->conflictsWith( $conflict ); + my ( $method, $args ) = $node->next_call(); + + ok( $result, '... but should return true if any node field conflicts' ); + + $node->{bar} = 2; + ok( ! $node->conflictsWith( $conflict ), '... false otherwise' ); + + $node->{foo} = 2; + ok( ! $node->conflictsWith( $conflict ), + '... and should ignore keepable keys' ); +} + +sub test_verify_field_update :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + my @fields; + + for my $field (qw( + createtime node_id type_nodetype hits loc_location reputation + lockedby_user locktime authoraccess groupaccess otheraccess guestaccess + dynamicauthor_permission dynamicgroup_permission + dynamicother_permission dynamicguest_permission + )) + { + push @fields, $field unless $node->verifyFieldUpdate( $field ); + } + + is( @fields, 16, + 'verifyFieldUpdate() should return false for unmodifiable fields' ); + ok( ! $node->verifyFieldUpdate( 'foo_id' ), '... and for _id fields' ); + ok( $node->verifyFieldUpdate( 'agoodkey' ), + '... but true for everything else' ); +} + +__END__ + $node->{getNode} = [ { key => 'value' } ]; + $node->{foo} = 11; + + delete $node->{type}{restrictdupes}; + $node->set_true('hasAccess')->set_list( getFields => 'foo' ) + ->set_always( getTableArray => ['table'] )->set_series( getNode => 0, {} ) + ->set_always( sqlSelect => 87 )->set_true('sqlInsert') + ->set_always( now => 'now' )->set_always( lastValue => 'lastValue' ) + ->set_true('cache')->clear(); +} + +__END__ $mock->{node_id} = 0; ok( defined( $result = insert( $mock, 'user' ) ), @@ -391,52 +612,6 @@ is( $mock->{node_id}, 0, '... should reset node_id' ); ok( $result, '... and return true' ); -# getNodeKeys() -$mock->clear(); - -my %keys = map { $_ => 1 } - qw( createtime modified hits reputation - lockedby_user locktime lastupdate foo_id bar ); - -$mock->set_always( getNodeDatabaseHash => \%keys )->clear(); - -$result = getNodeKeys($mock); - -is( $mock->next_call(), 'getNodeDatabaseHash', - 'getNodeKeys() should fetch node database keys' ); -is( scalar keys %$result, - 9, '... and should return them unchanged, if not exporting' ); - -$result = getNodeKeys( $mock, 1 ); -ok( !exists $result->{foo_id}, '... should return no uid keys if exporting' ); -is( join( ' ', keys %$result ), - 'bar', '... and should remove non-export keys as well' ); - -# fieldToXML() -{ - local *Everything::Node::node::genBasicTag; - - my @gbt; - *Everything::Node::node::genBasicTag = sub { - push @gbt, [@_]; - return 'tag'; - }; - - $mock->{afield} = 'thisfield'; - is( fieldToXML( $mock, $mock, 'afield' ), - 'tag', 'fieldToXML() should return an XML tag element' ); - is( scalar @gbt, 1, '... and should call genBasicTag()' ); - is( - join( ' ', @{ $gbt[0] } ), - "$mock field afield thisfield", - '... with the correct arguments' - ); - - ok( !fieldToXML( $mock, $mock, 'notafield' ), - '... and should return false if field does not exist' ); - ok( !exists $mock->{notafield}, '... and should not create field' ); -} - # xmlTag() $mock->set_series( getTagName => 'badtag', 'field', 'morefield' )->clear(); @@ -471,27 +646,6 @@ is( $mock->{parsed}, -1, '... setting node field to -1' ); } -# xmlFinal() -$mock->set_series( existingNodeMatches => $mock, 0 ) - ->set_true('updateFromImport')->set_true('insert')->clear(); - -$result = xmlFinal($mock); - -is( $mock->next_call(), 'existingNodeMatches', - 'xmlFinal() should check for a matching node' ); - -( $method, $args ) = $mock->next_call(); -is( $method, 'updateFromImport', '... updating node if so' ); -is( join( '+', @$args ), "$mock+$mock+-1", '... for node by superuser' ); -is( $result, $mock->{node_id}, '... returning the node_id' ); - -$mock->clear(); -$result = xmlFinal($mock); - -( $method, $args ) = $mock->next_call(2); -is( "$method $args->[1]", 'insert -1', '... or should insert the node' ); -is( $result, $mock->{node_id}, '... returning the new node_id' ); - # applyXMLFix() my $where = { title => 'title', type_nodetype => 'type', field => 'b' }; my $fix = { where => $where, field => 'fixme' }; @@ -544,100 +698,6 @@ is( $mock->{fixme}, 42, '... should set field to found node_id' ); ok( !$result, '... should return nothing on success' ); -# getIdentifyingFields() -is( getIdentifyingFields($mock), - undef, 'getIdentifyingFields() should return undef' ); - -# updateFromImport() -delete @$mock{ keys %$mock }; - -$mock->set_series( getNodeKeys => { foo => 1, bar => 2, baz => 3 } ) - ->set_series( getNodeKeepKeys => { bar => 1 } )->clear(); - -updateFromImport( $mock, { foo => 1, bar => 2, baz => 3 }, 'user' ); -( $method, $args ) = $mock->next_call(); -is( - "$method @$args", - "getNodeKeys $mock 1", - 'updateFromImport() should fetch node keys' -); -is( $mock->next_call(), 'getNodeKeepKeys', '... and keys to keep' ); -is( $mock->{foo} + $mock->{baz}, 4, '... should merge node keys' ); -ok( !exists $mock->{bar}, '... but not those that should be kept' ); -( $method, $args ) = $mock->next_call(); -is( - "$method @$args", - "update $mock user nomodify", - '... and should update node' -); -is( $mock->{modified}, 0, '... and should set "modified" to 0' ); - -# conflictsWith() -$mock->{modified} = ''; -ok( !conflictsWith($mock), - 'conflictsWith() should return false with no digit in "modified" field' ); - -$mock->{modified} = 1; - -my $keep = { foo => 1 }; -my $conflict = { foo => 1, bar => 2 }; - -$mock->set_series( getNodeKeys => $mock, $mock ) - ->set_series( getNodeKeepKeys => $keep, {} )->clear(); - -$mock->{foo} = 1; -$mock->{bar} = 3; -$result = conflictsWith( $mock, $conflict ); -( $method, $args ) = $mock->next_call(); -is( "$method @$args", "getNodeKeys $mock 1", '... and should fetch node keys' ); -is( $mock->next_call(), 'getNodeKeepKeys', '... and keepable keys' ); - -ok( $result, '... should return true if any node field conflicts' ); - -$mock->{bar} = 2; -ok( !conflictsWith( $mock, $conflict ), '... false otherwise' ); - -$mock->{foo} = 2; -ok( !conflictsWith( $mock, $conflict ), '... and should ignore keepable keys' ); - -# getNodeKeepKeys() -$result = getNodeKeepKeys($mock); -isa_ok( $result, 'HASH', 'getNodeKeepKeys() should return a hash reference' ); -foreach my $class (qw( author group other guest )) -{ - ok( $result->{"${class}access"}, "... and should contain $class access" ); - ok( - $result->{"dynamic${class}_permission"}, - "... and $class permission keys" - ); -} -ok( $result->{loc_location}, '... and location key' ); - -# verifyFieldUpdate() -my @fields; -foreach my $field ( - 'createtime', 'node_id', - 'type_nodetype', 'hits', - 'loc_location', 'reputation', - 'lockedby_user', 'locktime', - 'authoraccess', 'groupaccess', - 'otheraccess', 'guestaccess', - 'dynamicauthor_permission', 'dynamicgroup_permission', - 'dynamicother_permission', 'dynamicguest_permission' - ) -{ - push @fields, $field unless verifyFieldUpdate( $mock, $field ); -} - -is( scalar @fields, - 16, 'verifyFieldUpdate() should return false for unmodifiable fields' ); -ok( - !verifyFieldUpdate( $mock, 'foo_id' ), - '... and for primary key (uid) fields' -); -ok( verifyFieldUpdate( $mock, 'agoodkey' ), - '... but true for everything else' ); - # getRevision() $mock->{node_id} = 11; $mock->{DB} = $mock; @@ -940,27 +1000,3 @@ ( $method, $args ) = $mock->next_call(); is( "$method $args->[1]", "removeNode $mock", '... removing node from cache' ); is( $result, 41, '... and should return node_id' ); - -# restrictTitle() -ok( !restrictTitle( { foo => 1 } ), - 'restrictTitle() with no title field should return false' ); - -ok( - !restrictTitle( { title => '[foo]' } ), - '... or if title contains a square bracket' -); - -ok( !restrictTitle( { title => 'f>o<o' } ), '... or an angle bracket' ); - -{ - local *Everything::logErrors; - *Everything::logErrors = sub { $errors = shift }; - ok( !restrictTitle( { title => 'o|o' } ), '... or a pipe' ); -} -like( $errors, qr/node.+invalid characters/, '... and should log error' ); - -ok( - restrictTitle( { title => 'a good name zz9' } ), - '... but should return true otherwise' -); -} Modified: trunk/ebase/lib/Everything/Node/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/node.pm 2006-03-29 01:01:44 UTC (rev 838) +++ trunk/ebase/lib/Everything/Node/node.pm 2006-03-30 23:51:07 UTC (rev 839) @@ -1149,7 +1149,7 @@ sub restrictTitle { my ($this) = @_; - my $title = $this->{title} or return; + return unless my $title = $this->{title}; if ( $title =~ tr/[]|<>// ) { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-04-10 17:47:57
|
Revision: 840 Author: chromatic Date: 2006-04-10 10:47:45 -0700 (Mon, 10 Apr 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=840&view=rev Log Message: ----------- r15546@windwheel: chromatic | 2006-04-07 17:09:01 -0700 Migrated more of the test to Test::Class. Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/node.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:14510 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15546 Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-03-30 23:51:07 UTC (rev 839) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-10 17:47:45 UTC (rev 840) @@ -18,10 +18,9 @@ sub startup :Test( startup => 5 ) { my $self = shift; - my $mock = Test::MockObject->new(); - $self->{mock_db} = $mock; $self->{errors} = \(my @le); + my $mock = Test::MockObject->new(); $mock->fake_module( 'Everything', logErrors => sub { push @le, [@_] } ); *Everything::Node::node::DB = \$mock; @@ -61,6 +60,10 @@ $self->{mock} = Test::MockObject->new(); my $node = $self->node_class()->new(); $self->{node} = Test::MockObject::Extends->new( $node ); + my $db = Test::MockObject->new(); + + *Everything::Node::node::DB = \$db; + $self->{mock_db} = $db; } sub test_construct :Test( 1 ) @@ -115,14 +118,14 @@ $node->{type} = $node; $node->{restrictdupes} = 1; $node->{DB} = $db; - $node->set_true(qw( hasAccess restrictTitle getId )) - ->set_always( getTableArray => [] ); - $db->set_series( sqlSelect => 1, 0 ) - ->set_always( getFields => 'none' ) - ->set_always( now => '' ) - ->set_always( getNode => undef ) + $node->set_true(qw( -hasAccess -restrictTitle -getId )) + ->set_always( -getTableArray => [] ); + $db->set_series( -sqlSelect => 1, 0 ) + ->set_always( -getFields => 'none' ) + ->set_always( -now => '' ) + ->set_always( -getNode => undef ) ->set_true( 'sqlInsert' ) - ->set_always( lastValue => 100 ); + ->set_always( -lastValue => 100 ); is( $node->insert( '' ), 0, 'insert() should return 0 if dupes are restricted and exist' ); @@ -133,6 +136,139 @@ '... or should return the inserted node_id otherwise' ); } +sub test_insert :Test( 10 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $node->{node_id} = 0; + $node->{type} = $node; + $node->{restrictdupes} = 1; + $node->{DB} = $db; + + $node->set_true(qw( -hasAccess -restrictTitle -getId )); + $db->set_always( getNode => { key => 'value' } ) + ->set_always( -lastValue => 101 ); + $node->{foo} = 11; + + delete $node->{type}{restrictdupes}; + $db->set_list( -getFields => 'foo' ) + ->set_series( getNode => 0, {} ) + ->set_true( 'sqlInsert' ) + ->set_always( -now => 'now' ) + ->clear(); + + $node->set_always( -getTableArray => [ 'table' ] ) + ->set_true( 'cache' ); + $node->{node_id} = 0; + + ok( defined $node->insert( 'user' ), + '... but should return node_id if no dupes exist' ); + + my ( $method, $args ) = $db->next_call( 2 ); + is( $method, 'sqlInsert', '... inserting base node' ); + + is( $args->[1], 'node', '... into the node table' ); + is_deeply( $args->[2], + { + -createtime => 'now', + author_user => 'user', + hits => 0, + foo => 11, + }, + '... with the proper fields' + ); + + ( $method, $args ) = $db->next_call(); + is( $method, 'sqlInsert', '... inserting node' ); + is( $args->[1], 'table', '... into proper table' ); + is_deeply( $args->[2], { foo => 11, table_id => 101 }, + '... proper fields' ); + + ( $method, $args ) = $db->next_call(); + is( $method, 'getNode', '... fetching node' ); + is( join( '-', @$args ), "$db-101-force", '... forcing refresh' ); + is( $node->next_call(), 'cache', '... and caching node' ); +} + +sub test_update_access :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->set_false( 'hasAccess' ); + is( $node->update( 'user' ), 0, + 'update() should return 0 if user lacks write access' ); + + my ( $method, $args ) = $node->next_call(); + is( $method, 'hasAccess', '... so should check access' ); + is( join( '-', @$args ), "$node-user-w", '... write access for user' ); +} + +sub test_update_workspaced :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->{node_id} = 87; + $node->set_true( -hasAccess ) + ->set_series( updateWorkspaced => 77, 0 ) + ->set_true( -canWorkspace ); + + $db->{workspace}{nodes}{ $node->{node_id} } = 1; + $node->{DB} = $db; + + my $result = $node->update( 'user' ); + + my ( $method, $args ) = $node->next_call(); + is( $method, 'updateWorkspaced', + 'update() should update workspaced node if it is workspaced' ); + is( $args->[1], 'user', '... for user' ); + is( $result, 77, '... and should return the id if it that works' ); +} + +sub test_update :Test( 11 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->{type} = $node; + $node->{boom} = 88; + $node->{foom} = 99; + $node->{DB} = $db; + $db->{cache} = $db; + + $node->set_true( -hasAccess ) + ->set_always( getTableArray => [ 'table', 'table2' ] ) + ->set_true( 'cache' ); + + $db->set_true(qw( incrementGlobalVersion sqlUpdate now sqlSelect )) + ->set_series( getFields => 'boom', 'foom' ); + + $node->update( 'user' ); + is( $db->next_call(), 'incrementGlobalVersion', + '... incrementing global version in cache' ); + is( $node->next_call(), 'cache', '... caching node' ); + + my $method = $db->next_call(); + is( $db->next_call(), 'sqlSelect', + '... updating modified field without flag' ); + is( $method, 'now', '... with current time' ); + is( $node->next_call(), 'getTableArray', '... fetching type tables' ); + + ( $method, my $args ) = $db->next_call(); + is( $method, 'getFields', '... fetching the fields' ); + is( $args->[1], 'table', '... of each table' ); + + ( $method, $args ) = $db->next_call(); + is( "$method $args->[1]", 'sqlUpdate table', '... updating each table' ); + is( keys %{ $args->[2] }, 1, + '... with only allowed fields' ); + is( $args->[3], 'table_id = ?', '... for table' ); + is_deeply( $args->[4], [ $node->{node_id} ], '... with node id' ); +} + sub test_is_group :Test( 1 ) { ok( ! shift->{node}->isGroup(), 'isGroup() should return false' ); @@ -410,110 +546,6 @@ } __END__ - $node->{getNode} = [ { key => 'value' } ]; - $node->{foo} = 11; - - delete $node->{type}{restrictdupes}; - $node->set_true('hasAccess')->set_list( getFields => 'foo' ) - ->set_always( getTableArray => ['table'] )->set_series( getNode => 0, {} ) - ->set_always( sqlSelect => 87 )->set_true('sqlInsert') - ->set_always( now => 'now' )->set_always( lastValue => 'lastValue' ) - ->set_true('cache')->clear(); -} - -__END__ -$mock->{node_id} = 0; -ok( - defined( $result = insert( $mock, 'user' ) ), - '... but should return node_id if no dupes exist' -); - -( $method, $args ) = $mock->next_call(6); -is( $method, 'sqlInsert', '... inserting base node' ); - -is( $args->[1], 'node', '... into the node table' ); -is_deeply( - $args->[2], - { - -createtime => 'now', - author_user => 'user', - hits => 0, - foo => 11, - }, - '... with the proper fields' -); - -is( $mock->next_call(), 'lastValue', '... fetching node id' ); -is( $mock->next_call(), 'getTableArray', '... and node tables' ); -is( $mock->next_call(), 'getFields', '... and table fields' ); - -( $method, $args ) = $mock->next_call(); -is( $method, 'sqlInsert', '... inserting node' ); -is( $args->[1], 'table', '... into proper table' ); -is_deeply( - $args->[2], - { foo => 11, table_id => 'lastValue' }, - '... proper fields' -); - -( $method, $args ) = $mock->next_call(); -is( $method, 'getNode', '... fetching node' ); -is( join( '-', @$args ), "$mock-lastValue-force", '... forcing refresh' ); -is( $mock->next_call(), 'cache', '... and caching node' ); - -# update() -$mock->{node_id} = 87; -$mock->set_series( hasAccess => 0, 1, 1 ) - ->set_series( updateWorkspaced => 77, 0 )->clear() - ->set_true( -canWorkspace ); - -is( update( $mock, 'user' ), - 0, 'update() should return 0 if user lacks write access' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'hasAccess', '... so should check access' ); -is( join( '-', @$args ), "$mock-user-w", '... write access for user' ); - -$mock->{workspace}{nodes}{ $mock->{node_id} } = 1; -$mock->{DB} = $mock; -$mock->{cache} = $mock; -$result = update( $mock, 'user' ); - -( $method, $args ) = $mock->next_call(2); -is( $method, 'updateWorkspaced', - '... should update workspaced node if it is workspaced' ); -is( $args->[1], 'user', '... for user' ); -is( $result, 77, '... and should return the id if it that works' ); - -delete $mock->{workspace}; -$mock->{type} = $mock; -$mock->{boom} = 88; -$mock->{foom} = 99; - -$mock->set_always( getTableArray => [ 'table', 'table2' ] ) - ->set_series( getFields => 'boom', 'foom' ) - ->set_true('incrementGlobalVersion')->set_true('sqlUpdate')->clear(); - -update( $mock, 'user' ); -is( $mock->next_call(2), 'incrementGlobalVersion', - '... incrementing global version in cache' ); -is( $mock->next_call(), 'cache', '... caching node' ); - -$method = $mock->next_call(); -is( $mock->next_call(), 'sqlSelect', - '... updating modified field without flag' ); -is( $method, 'now', '... with current time' ); -is( $mock->next_call(), 'getTableArray', '... fetching type tables' ); - -( $method, $args ) = $mock->next_call(); -is( $method, 'getFields', '... fetching thte fields' ); -is( $args->[1], 'table', '... of each table' ); - -( $method, $args ) = $mock->next_call(); -is( "$method $args->[1]", 'sqlUpdate table', '... updating each table' ); -is( keys %{ $args->[2] }, 1, '... with only allowed fields' ); -is( $args->[3], 'table_id = ?', '... for table' ); -is_deeply( $args->[4], [ $mock->{node_id} ], '... with node id' ); - # nuke() $mock->set_series( hasAccess => 0, 1 ) ->set_series( isGroupType => 0, 'table1', 'table2' ) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-04-10 17:48:14
|
Revision: 841 Author: chromatic Date: 2006-04-10 10:47:57 -0700 (Mon, 10 Apr 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=841&view=rev Log Message: ----------- r15547@windwheel: chromatic | 2006-04-07 17:09:16 -0700 Still more migration to Test::Class. Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/node.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15546 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15547 Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-10 17:47:45 UTC (rev 840) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-10 17:47:57 UTC (rev 841) @@ -18,10 +18,14 @@ sub startup :Test( startup => 5 ) { my $self = shift; - $self->{errors} = \(my @le); + $self->{errors} = []; my $mock = Test::MockObject->new(); - $mock->fake_module( 'Everything', logErrors => sub { push @le, [@_] } ); + $mock->fake_module( 'Everything', logErrors => sub + { + push @{ $self->{errors} }, [@_] + } + ); *Everything::Node::node::DB = \$mock; my $module = $self->node_class(); @@ -64,6 +68,8 @@ *Everything::Node::node::DB = \$db; $self->{mock_db} = $db; + $node->{DB} = $db; + $self->{errors} = []; } sub test_construct :Test( 1 ) @@ -117,7 +123,6 @@ $node->{node_id} = 0; $node->{type} = $node; $node->{restrictdupes} = 1; - $node->{DB} = $db; $node->set_true(qw( -hasAccess -restrictTitle -getId )) ->set_always( -getTableArray => [] ); $db->set_series( -sqlSelect => 1, 0 ) @@ -144,7 +149,6 @@ $node->{node_id} = 0; $node->{type} = $node; $node->{restrictdupes} = 1; - $node->{DB} = $db; $node->set_true(qw( -hasAccess -restrictTitle -getId )); $db->set_always( getNode => { key => 'value' } ) @@ -216,7 +220,6 @@ ->set_true( -canWorkspace ); $db->{workspace}{nodes}{ $node->{node_id} } = 1; - $node->{DB} = $db; my $result = $node->update( 'user' ); @@ -236,7 +239,6 @@ $node->{type} = $node; $node->{boom} = 88; $node->{foom} = 99; - $node->{DB} = $db; $db->{cache} = $db; $node->set_true( -hasAccess ) @@ -354,14 +356,10 @@ $node->{title} = 'f>o<o'; ok( ! $node->restrictTitle(), '... or an angle bracket' ); - my $errors; - { - local *Everything::logErrors; - *Everything::logErrors = sub { $errors = shift }; - $node->{title} = 'o|o'; - ok( ! $node->restrictTitle(), '... or a pipe' ); - } - like( $errors, qr/node.+invalid characters/, '... and should log error' ); + $node->{title} = 'o|o'; + ok( ! $node->restrictTitle(), '... or a pipe' ); + like( $self->{errors}[0][0], qr/node.+invalid characters/, + '... and should log error' ); $node->{title} = 'a good name zz9'; ok( $node->restrictTitle(), '... but should return true otherwise' ); @@ -435,6 +433,41 @@ ok( ! exists $node->{notafield}, '... and should not create field' ); } +sub test_xml_tag :Test( 9 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_series( getTagName => 'badtag', 'field', 'morefield' )->clear(); + + $node->{type} = $node; + $node->{title} = 'thistype'; + my $result = $node->xmlTag( $node ); + is( $node->next_call(), 'getTagName', 'xmlTag() should fetch tag name' ); + ok( !$result, '... and should return false unless it contains "field"' ); + like( $self->{errors}[0][1], qr/tag 'badtag'.+'thistype'/, + '... logging an error' ); + + local *Everything::XML::parseBasicTag; + my @pbt; + my $parse = { name => 'parsed', parsed => 11 }; + *Everything::XML::parseBasicTag = sub { + push @pbt, [@_]; + return $parse; + }; + + $result = $node->xmlTag( $node ); + is( join( ' ', @{ $pbt[0] } ), "$node node", '... should parse tag' ); + is( $result, undef, '... should return false with no fixes' ); + is( $node->{parsed}, 11, '... and should set node field to tag value' ); + + $parse->{where} = 1; + $result = $node->xmlTag( $node ); + isa_ok( $result, 'ARRAY', '... should return array ref if fixes exist' ); + is( $result->[0], $parse, '... with the fix in the array ref' ); + is( $node->{parsed}, -1, '... setting node field to -1' ); +} + sub test_get_identifying_fields :Test( 1 ) { my $self = shift; @@ -545,139 +578,111 @@ '... but true for everything else' ); } -__END__ -# nuke() -$mock->set_series( hasAccess => 0, 1 ) - ->set_series( isGroupType => 0, 'table1', 'table2' ) - ->set_series( sqlSelectMany => 0, $mock ) - ->set_always( getTableArray => ['deltable'] )->set_always( getId => 'id' ) - ->set_series( fetchrow => 'group' )->set_series( sqlDelete => (1) x 4 ) - ->set_true('getRef')->set_true('finish')->set_true('removeNode')->clear(); +sub test_nuke_access :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $node->set_false( 'hasAccess' ); + $db->set_true( 'getRef' ); -$result = nuke( $mock, 'user' ); + my $result = $node->nuke( 'user' ); -( $method, $args ) = $mock->next_call(); -is( "$method $args->[1]", - 'getRef user', 'nuke() should fetch user node unless it is -1' ); -ok( !$result, '... and should return false if user lacks delete access' ); + my ( $method, $args ) = $db->next_call(); + is( "$method $args->[1]", + 'getRef user', 'nuke() should fetch user node unless it is -1' ); + ok( !$result, '... returning false if user lacks delete access' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'hasAccess', '... and should check for access' ); -is( join( '-', @$args ), "$mock-user-d", '... delete access for user' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'hasAccess', '... and should check for access' ); + is( join( '-', @$args ), "$node-user-d", '... delete access for user' ); +} -$mock->{dbh} = $mock; -$mock->clear(); +sub test_nuke :Test( 27 ) { - my $gat; - $mock->mock( getAllTypes => sub { $gat++; return ($mock) x 3 } ); - $result = nuke( $mock, -1 ); - ok( $gat, '... should get all nodetypes' ); - $mock->set_false('getAllTypes'); -} + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $node->{type} = $node; + $db->{cache} = $db; + $node->{node_id} = 89; -isnt( $mock->next_call(), 'getRef', - '... and should not get user node if it is -1' ); -( $method, $args ) = $mock->next_call(2); -is( $method, 'sqlDelete', '... should delete links' ); -is( - join( '-', @$args[ 1, 2 ] ), - 'links-to_node=? OR from_node=?', - '... should delete from or to links from links table' -); -is_deeply( $args->[3], [ 'id', 'id' ], '... with bound node id' ); + $node->set_true( 'hasAccess' ) + ->set_series( isGroupType => 0, 'table1', 'table2' ) + ->set_always( getTableArray => [ 'deltable' ] ) + ->set_always( -getId => 'id' ); + $db->set_true(qw( getRef finish removeNode incrementGlobalVersion )) + ->set_always( getNode => $db ) + ->set_series( sqlSelectMany => 0, $db ) + ->set_series( fetchrow => 'group' ) + ->set_series( sqlDelete => (1) x 4 ); -( $method, $args ) = $mock->next_call(); -is( $method, 'sqlDelete', '... and deleting node revisions' ); -is( - join( '-', @$args[ 1, 2 ] ), - 'revision-node_id = ?', - '... by id from revision' -); -is_deeply( $args->[3], [87], '... with node_id' ); + my $result; + { + my $gat; + $db->mock( getAllTypes => sub { $gat++; return ($node) x 3 } ); + $result = $node->nuke( -1 ); + ok( $gat, '... should get all nodetypes' ); + $db->set_false( 'getAllTypes' ); + } -is( $mock->next_call(2), 'isGroupType', - '... should check each type is a group node' ); + isnt( $node->next_call(), 'getRef', + '... and should not get user node if it is -1' ); + my ( $method, $args ) = $db->next_call(); + is( $method, 'sqlDelete', '... should delete links' ); + is( join( '-', @$args[ 1, 2 ] ), 'links-to_node=? OR from_node=?', + '... should delete from or to links from links table' ); + is_deeply( $args->[3], [ 'id', 'id' ], '... with bound node id' ); -( $method, $args ) = $mock->next_call(2); -is( $method, 'sqlSelectMany', '... should check for node' ); -is( - join( '-', @$args[ 1 .. 3 ] ), - 'table1_id-table1-node_id = ?', - '... in group table' -); -is_deeply( $args->[5], [87], '... by node_id' ); + ( $method, $args ) = $db->next_call(); + is( $method, 'sqlDelete', '... and deleting node revisions' ); + is( join( '-', @$args[ 1, 2 ] ), 'revision-node_id = ?', + '... by id from revision' ); + is_deeply( $args->[3], [89], '... with node_id' ); -is( $mock->next_call(3), 'fetchrow', - '... if it exists, should fetch all containing groups' ); -( $method, $args ) = $mock->next_call(3); -is( $method, 'sqlDelete', '... and should delete' ); -is( - join( '-', @$args[ 1 .. 2 ] ), - 'table2-node_id = ?', - '... from table on node_id' -); -is_deeply( $args->[3], [87], '... for node' ); + is( $node->next_call(), 'isGroupType', + '... should check each type is a group node' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'getNode', '... fetching node' ); -is( join( '-', @$args ), "$mock-group", '... for containing group' ); + ( $method, $args ) = $db->next_call(2); + is( $method, 'sqlSelectMany', '... should check for node' ); + is( join( '-', @$args[ 1 .. 3 ] ), 'table1_id-table1-node_id = ?', + '... in group table' ); + is_deeply( $args->[5], [89], '... by node_id' ); -is( $mock->next_call(), 'incrementGlobalVersion', '... forcing a reload' ); + is( $db->next_call(3), 'fetchrow', + '... if it exists, should fetch all containing groups' ); + ( $method, $args ) = $db->next_call( 2 ); + is( $method, 'sqlDelete', '... and should delete' ); + is( join( '-', @$args[ 1 .. 2 ] ), 'table2-node_id = ?', + '... from table on node_id' ); + is_deeply( $args->[3], [89], '... for node' ); -( $method, $args ) = $mock->next_call(); -is( - "$method @$args", - "getTableArray $mock 1", - '... should fetch all tables for node' -); + ( $method, $args ) = $db->next_call(); + is( $method, 'getNode', '... fetching node' ); + is( join( '-', @$args ), "$db-group", '... for containing group' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'sqlDelete', '... deleting node' ); -is( join( '-', @$args[ 1, 2 ] ), 'deltable-deltable_id = ?', - '... from tables' ); -is_deeply( $args->[3], ['id'], '... by node_id' ); -is( $mock->next_call(), 'incrementGlobalVersion', - '... should mark node as updated in cache' ); + is( $db->next_call(), 'incrementGlobalVersion', '... forcing a reload' ); -( $method, $args ) = $mock->next_call(); -is( "$method @$args", "removeNode $mock $mock", '... uncaching it' ); -is( $mock->{node_id}, 0, '... should reset node_id' ); -ok( $result, '... and return true' ); + ( $method, $args ) = $node->next_call( 3 ); + is( "$method @$args", "getTableArray $node 1", + '... should fetch all tables for node' ); -# xmlTag() -$mock->set_series( getTagName => 'badtag', 'field', 'morefield' )->clear(); + ( $method, $args ) = $db->next_call(); + is( $method, 'sqlDelete', '... deleting node' ); + is( join( '-', @$args[ 1, 2 ] ), 'deltable-deltable_id = ?', + '... from tables' ); + is_deeply( $args->[3], ['id'], '... by node_id' ); + is( $db->next_call(), 'incrementGlobalVersion', + '... should mark node as updated in cache' ); -$mock->{title} = 'thistype'; -my $out; -my $errors; -local *Everything::logErrors; -*Everything::logErrors = sub { (undef, $errors) = @_ }; -{ - $result = xmlTag( $mock, $mock ); - is( $mock->next_call(), 'getTagName', 'xmlTag() should fetch tag name' ); - ok( !$result, '... and should return false unless it contains "field"' ); - like( $errors, qr/tag 'badtag'.+'thistype'/, '... logging an error' ); + ( $method, $args ) = $db->next_call(); + is( "$method @$args", "removeNode $db $node", '... uncaching it' ); + is( $node->{node_id}, 0, '... should reset node_id' ); + ok( $result, '... and return true' ); +} - local *Everything::XML::parseBasicTag; - my @pbt; - my $parse = { name => 'parsed', parsed => 11 }; - *Everything::XML::parseBasicTag = sub { - push @pbt, [@_]; - return $parse; - }; +__END__ - $result = xmlTag( $mock, $mock ); - is( join( ' ', @{ $pbt[0] } ), "$mock node", '... should parse tag' ); - is( $result, undef, '... should return false with no fixes' ); - is( $mock->{parsed}, 11, '... and should set node field to tag value' ); - - $parse->{where} = 1; - $result = xmlTag( $mock, $mock ); - isa_ok( $result, 'ARRAY', '... should return array ref if fixes exist' ); - is( $result->[0], $parse, '... with the fix in the array ref' ); - is( $mock->{parsed}, -1, '... setting node field to -1' ); -} - # applyXMLFix() my $where = { title => 'title', type_nodetype => 'type', field => 'b' }; my $fix = { where => $where, field => 'fixme' }; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-04-14 00:13:47
|
Revision: 843 Author: chromatic Date: 2006-04-13 17:13:31 -0700 (Thu, 13 Apr 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=843&view=rev Log Message: ----------- r15652@windwheel: chromatic | 2006-04-13 17:13:21 -0700 Started adding Test::Class tests for nodetype node. This meant fixing a few mistakes in the node test. Note that the behavior of SUPER() will change soon! Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/Test/node.pm trunk/ebase/lib/Everything/Node/nodetype.pm trunk/ebase/t/Node/nodetype.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/nodetype.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15650 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15652 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-04-10 23:38:22 UTC (rev 842) +++ trunk/ebase/MANIFEST 2006-04-14 00:13:31 UTC (rev 843) @@ -88,6 +88,7 @@ lib/Everything/Node/usergroup.pm lib/Everything/Node/workspace.pm lib/Everything/Node/Test/node.pm +lib/Everything/Node/Test/nodetype.pm lib/Everything/Nodeball.pm lib/Everything/NodeBase.pm lib/Everything/NodeBase/mysql.pm Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-10 23:38:22 UTC (rev 842) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-14 00:13:31 UTC (rev 843) @@ -13,9 +13,7 @@ sub node_class { 'Everything::Node::node' } -my $module = 'Everything::Node::node'; - -sub startup :Test( startup => 5 ) +sub startup :Test( startup => 4 ) { my $self = shift; $self->{errors} = []; @@ -39,7 +37,6 @@ } use_ok( $module ) or exit; - is( keys %import, 4, "$module should use several modules" ); ok( $module->isa( 'Everything::Node' ), "$module should extend Everything::Node" ); @@ -1055,3 +1052,5 @@ is( $node->{node_id}, 0, '... should reset node_id' ); ok( $result, '... and return true' ); } + +1; Added: trunk/ebase/lib/Everything/Node/Test/nodetype.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/nodetype.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/nodetype.pm 2006-04-14 00:13:31 UTC (rev 843) @@ -0,0 +1,336 @@ +package Everything::Node::Test::nodetype; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; +use Test::More; +use SUPER; + +# XXX - hack for now +*Everything::Node::nodetype::SUPER = \&UNIVERSAL::SUPER; + +sub node_class { 'Everything::Node::nodetype' } + +sub startup :Test( +1 ) +{ + my $self = shift; + $self->SUPER::startup(); + isa_ok( $self->node_class()->new(), 'Everything::Node::node' ); +} + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $module = $self->node_class(); + can_ok( $module, 'dbtables' ); + my @tables = $module->dbtables(); + is_deeply( \@tables, [qw( nodetype node )], + 'dbtables() should return node tables' ); +} + +sub test_construct :Test( 16 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->set_true(qw( SUPER )); + $db->set_true( 'finish' ); + + $node->{node_id} = $node->{extends_nodetype} = 0; + $node->{sqltable} = 'foo,bar,baz'; + + ok( $node->construct(), + 'construct() should always succeed (unless it dies)' ); + + is( $node->next_call(), 'SUPER', '... should call SUPER()' ); + isa_ok( $node->{tableArray}, 'ARRAY', + '... storing necessary tables in "tableArray" field as something that' ); + + $node->{node_id} = 1; + $db->set_always( sqlSelect => 1 ) + ->set_always( sqlSelectJoined => $db ) + ->set_always( fetchrow_hashref => $node ); + + @$node{ + qw( + defaultguest_permission defaultguestaccess defaultgroupaccess + defaultauthoraccess canworkspace maxrevisions defaultauthor_permission + defaultgroup_permission defaultgroup_usergroup defaultotheraccess + defaultother_permission grouptable + ) + } + = ('') x 12; + + $node->construct(); + is( $node->{type}, $node, '... should set node number 1 type to itself' ); + + my ( $method, $args ) = $db->next_call(); + is( $method, 'sqlSelect', '... fetching a node if the node_id is 1' ); + is( join( '-', @$args ), + "$db-node_id-node-title='node' AND type_nodetype=1", + '... with the appropriate parameters' ); + + ( $method, $args ) = $db->next_call(); + is( $method, 'sqlSelectJoined', '... fetching its nodetype data' ); + like( join( ' ', @$args ), qr/\* nodetype.+nodetype_id=/, + '... with the appropriate arguments' ); + is( $db->next_call(), 'fetchrow_hashref', + '... populating nodetype node with nodetype data' ); + + my @fields = + qw( sqltable maxrevisions canworkspace grouptable defaultgroup_usergroup ); + @$node{@fields} = ('') x @fields; + + for my $class (qw( author group guest other )) + { + my @classfields = ( "default${class}access", "default${class}_permission" ); + push @fields, @classfields; + @$node{@classfields} = ( -1, -1 ); + } + + $node->{extends_nodetype} = $node->{node_id} = 6; + + my $parent = { map { $_ => $_, "derived_$_" => $_ } @fields }; + $parent->{derived_defaultguestaccess} = 100; + $node->{defaultguestaccess} = 1; + $parent->{derived_sqltable} = 'boo,far'; + + $db->set_always( getNode => $parent ); + + my $ip; + { + local *Everything::Security::inheritPermissions; + *Everything::Security::inheritPermissions = sub { + $ip = join( ' ', @_ ); + }; + + $node->construct(); + } + + ( $method, $args ) = $db->next_call(2); + is( $method, 'getNode', '... fetching nodetype data, if necessary' ); + is( $args->[1], 6, '... for parent' ); + is( $node->{derived_grouptable}, + 'grouptable', '... should copy derived fields if they are inherited' ); + + # misleading, I know... + is( $node->{defaultgroupaccess}, -1, '... but should not copy other fields' ); + is( $ip, '1 100', + '... should call inheritPermissions() for permission fields' ); + is( $node->{derived_sqltable}, + 'boo,far', '... should add sqltable fields to the list' ); + is( $node->{derived_grouptable}, + 'grouptable', + '... should use parent grouptable if none more specific exists' ); +} + +sub test_destruct :Test() +{ + my $self = shift; + my $node = $self->{node}; + $node->{tableArray} = 1; + $node->destruct(); + ok( !exists $node->{tableArray}, + 'destruct() should remove "tableArray" field' ); +} + +sub test_insert :Test( +4 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->{extends_nodetype} = 100; + $node->{type_nodetype} = 200; + $self->SUPER::test_insert(); + delete $node->{extends_nodetype}; + $node->{DB} = $db; + $node->set_true( 'SUPER' ); + + $db->set_series( getType => map { { node_id => $_ } } ( 11, 12, 11 ) ); + + $node->insert( 'user' ); + my ( $method, $args ) = $db->next_call(); + is( $method, 'getType', 'insert() with no parent should extend a type' ); + is( $args->[1], 'node', '... the node type, by default' ); + + $node->{extends_nodetype} = 0; + + $node->insert( 'user' ); + is( $node->{extends_nodetype}, 12, '... or if the parent is 0' ); + + # make it extend itself, should not work + $node->{type_nodetype} = 12; + $db->{cache} = $node; + + $node->insert( 'user' ); + isnt( $node->{extends_nodetype}, 12, + '... and should not be allowed to extend itself' ); +} + +sub test_insert_access +{ + my $self = shift; + my $node = $self->{node}; + $node->{extends_nodetype} = 1; + $node->{type_nodetype} = 2; + $self->SUPER::test_insert_access( @_ ); +} + +sub test_insert_restrict_dupes +{ + my $self = shift; + my $node = $self->{node}; + $node->{extends_nodetype} = 1; + $node->{type_nodetype} = 2; + $self->SUPER::test_insert_restrict_dupes( @_ ); +} + +sub test_insert_restrictions +{ + my $self = shift; + my $node = $self->{node}; + $node->{extends_nodetype} = 1; + $node->{type_nodetype} = 2; + $self->SUPER::test_insert_restrictions( @_ ); +} + +sub test_update :Test( +3 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->set_true( 'flushCacheGlobal' ); + $self->SUPER::test_update( @_ ); + + $db->{cache} = $node; + $node->set_series( SUPER => undef, 47 ); + $node->set_true( 'flushCacheGlobal' )->clear(); + + $node->update(); + is( $node->next_call(), 'SUPER', 'update() should call SUPER()' ); + + $node->{cache} = $node; + is( $node->update(), 47, '... and return the results' ); + is( $node->next_call( 2 ), 'flushCacheGlobal', + '... flushing the global cache, if SUPER() is successful' ); +} + +1; + +__END__ + +# nuke() + +# getTableArray() +$mock->{tableArray} = [ 1 .. 4 ]; +$result = getTableArray($mock); +is( ref $result, 'ARRAY', + 'getTableArray() should return array ref to "tableArray" field' ); +is( scalar @$result, 4, '... and should contain all items' ); +ok( !grep( { $_ eq 'node' } @$result ), + '... should not provide "node" table with no arguments' ); +is( getTableArray( $mock, 1 )->[-1], + 'node', '... but should happily provide it with $mockTable set to true' ); + +# getDefaultTypePermissions() +is( + getDefaultTypePermissions( $mock, 'author' ), + $mock->{derived_defaultauthoraccess}, + 'getDefaultTypePermissions() should return derived permissions for class' +); +ok( + !getDefaultTypePermissions( $mock, 'fakefield' ), + '... should return false if field does not exist' +); +ok( + !exists $mock->{derived_defaultfakefieldaccess}, + '... and should not autovivify bad field' +); + +# getParentType() +$mock->set_always( getType => 88 )->clear(); + +$mock->{extends_nodetype} = 77; +$result = getParentType($mock); +( $method, $args ) = $mock->next_call(); +is( $method, 'getType', + 'getParentType() should get parent type from the database, if it exists' ); +is( $args->[1], 77, '... with the parent id' ); +is( $result, 88, '... returning it' ); + +$mock->{extends_nodetype} = 0; +is( getParentType($mock), undef, + '... but should return false if it fails (underived nodetype)' ); + +# hasTypeAccess() +$mock->set_always( getNode => $mock )->set_always( hasAccess => 'acc' ) + ->clear(); + +hasTypeAccess( $mock, 'user', 'modes' ); +( $method, $args ) = $mock->next_call(); +is( $method, 'getNode', 'hasTypeAccess() should fetch node to check perms' ); +is( + join( '-', @$args ), + "$mock-dummy_access_node-$mock-create force", + '... forcing a dummy nodetype node' +); +( $method, $args ) = $mock->next_call(); +is( $method, 'hasAccess', '... checking access on result' ); +is( join( '-', @$args ), "$mock-user-modes", '... for user and permissions' ); + +# isGroupType() +is( + isGroupType($mock), + $mock->{derived_grouptable}, + 'isGroupType() should return "derived_grouptable" if it exists' +); +delete $mock->{derived_grouptable}, + is( isGroupType($mock), undef, '... and false if it does not' ); + +# derivesFrom() +$mock->set_series( + getType => 0, + { type_nodetype => 2 }, + { type_nodetype => 1, node_id => 88 }, + { type_nodetype => 1, node_id => 99 } +)->set_always( getParentType => $mock )->clear(); + +$result = derivesFrom( $mock, 'foo' ); +is( $mock->next_call(), 'getType', + 'derivesFrom() should find the type of the first parameter' ); +is( $result, 0, '... returning 0 unless it exists' ); + +is( derivesFrom( $mock, 'bar' ), 0, '... or if it is not a nodetype node' ); + +$mock->{node_id} = 77; +my $gpt = 0; +{ + $mock->mock( + getParentType => sub { + return if $gpt; + $gpt = 1; + $mock->{node_id} = 88; + return $mock; + } + ); + $result = derivesFrom( $mock, 'theboatashore' ); +} +ok( $gpt, '... and should walk up hierarchy with getParentType() as needed' ); +is( $result, 1, '... returning true if the nodes are related' ); +is( derivesFrom( $mock, '' ), 0, '... and false otherwise' ); + +# getNodeKeepKeys() +$mock->set_always( SUPER => { foo => 1 } )->clear(); + +$result = getNodeKeepKeys($mock); +is( $mock->next_call(), 'SUPER', 'getNodeKeepKeys() should call SUPER()' ); +is( ref $result, 'HASH', '... and should return a hash reference' ); +is( scalar grep( /default.+access/, keys %$result ), + 4, '... and should save class access keys' ); +is( $result->{defaultgroup_usergroup}, 1, '... and the default usergroup key' ); +is( scalar grep( /default.+permission/, keys %$result ), + 4, '... and default class permission keys' ); Property changes on: trunk/ebase/lib/Everything/Node/Test/nodetype.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/nodetype.pm =================================================================== --- trunk/ebase/lib/Everything/Node/nodetype.pm 2006-04-10 23:38:22 UTC (rev 842) +++ trunk/ebase/lib/Everything/Node/nodetype.pm 2006-04-14 00:13:31 UTC (rev 843) @@ -170,7 +170,7 @@ sub insert { - my ($this) = @_; + my $this = shift; if ( not defined $this->{extends_nodetype} or $this->{extends_nodetype} == 0 @@ -179,7 +179,7 @@ $this->{extends_nodetype} = $this->{DB}->getType('node')->{node_id}; } - return $this->SUPER(); + return $this->SUPER( @_ ); } =head2 C<update> @@ -193,10 +193,9 @@ sub update { - my ($this) = @_; + my $this = shift; + my $result = $this->SUPER( @_ ); - my $result = $this->SUPER(); - # If the nodetype was successfully updated, we need to flush the # cache to make sure all the nodetypes get reloaded. $this->{DB}{cache}->flushCacheGlobal() if $result; Modified: trunk/ebase/t/Node/nodetype.t =================================================================== --- trunk/ebase/t/Node/nodetype.t 2006-04-10 23:38:22 UTC (rev 842) +++ trunk/ebase/t/Node/nodetype.t 2006-04-14 00:13:31 UTC (rev 843) @@ -3,6 +3,13 @@ use strict; use warnings; +=cut + +use Everything::Node::Test::nodetype; +Everything::Node::Test::nodetype->runtests(); + +=cut + BEGIN { chdir 't' if -d 't'; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-04-14 23:29:38
|
Revision: 844 Author: chromatic Date: 2006-04-14 16:29:29 -0700 (Fri, 14 Apr 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=844&view=rev Log Message: ----------- r15760@windwheel: chromatic | 2006-04-14 16:29:17 -0700 Finished porting the nodetype tests to Test::Class. Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/nodetype.pm trunk/ebase/t/Node/nodetype.t Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15652 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15760 Modified: trunk/ebase/lib/Everything/Node/Test/nodetype.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/nodetype.pm 2006-04-14 00:13:31 UTC (rev 843) +++ trunk/ebase/lib/Everything/Node/Test/nodetype.pm 2006-04-14 23:29:29 UTC (rev 844) @@ -219,118 +219,177 @@ '... flushing the global cache, if SUPER() is successful' ); } -1; +sub test_nuke_access :Test( +0 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $db->set_series( -getNode => 0 ); + $self->SUPER(); +} -__END__ +sub test_nuke :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $node->{DB} = $db; + $db->set_series( getNode => 1 ); -# nuke() + my $result = $node->nuke( 'user' ); + is( $result, 0, + 'nuke() should return false if nodes of this nodetype exist' ); -# getTableArray() -$mock->{tableArray} = [ 1 .. 4 ]; -$result = getTableArray($mock); -is( ref $result, 'ARRAY', - 'getTableArray() should return array ref to "tableArray" field' ); -is( scalar @$result, 4, '... and should contain all items' ); -ok( !grep( { $_ eq 'node' } @$result ), - '... should not provide "node" table with no arguments' ); -is( getTableArray( $mock, 1 )->[-1], - 'node', '... but should happily provide it with $mockTable set to true' ); + like( $self->{errors}[0][0], qr/Can't delete.+still exist/, + '... giving an appropriate error message' ); -# getDefaultTypePermissions() -is( - getDefaultTypePermissions( $mock, 'author' ), - $mock->{derived_defaultauthoraccess}, - 'getDefaultTypePermissions() should return derived permissions for class' -); -ok( - !getDefaultTypePermissions( $mock, 'fakefield' ), - '... should return false if field does not exist' -); -ok( - !exists $mock->{derived_defaultfakefieldaccess}, - '... and should not autovivify bad field' -); + $node->set_always( ('SUPER') x 2 ); + $result = $node->nuke( 'user' ); + is( $node->next_call(), 'SUPER', + '... otherwise calling parent implementation' ); + is( $result, 'SUPER', '... and returning result' ); +} -# getParentType() -$mock->set_always( getType => 88 )->clear(); +sub test_get_table_array :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->{tableArray} = [ 1 .. 4 ]; -$mock->{extends_nodetype} = 77; -$result = getParentType($mock); -( $method, $args ) = $mock->next_call(); -is( $method, 'getType', - 'getParentType() should get parent type from the database, if it exists' ); -is( $args->[1], 77, '... with the parent id' ); -is( $result, 88, '... returning it' ); + my $result = $node->getTableArray(); + is( ref $result, 'ARRAY', + 'getTableArray() should return array ref to "tableArray" field' ); + is( @$result, 4, '... and should contain all items' ); + ok( !grep( { $_ eq 'node' } @$result ), + '... should not provide "node" table with no arguments' ); + is( $node->getTableArray( 1 )->[-1], 'node', + '... but should happily provide it with $nodeTable set to true' ); +} -$mock->{extends_nodetype} = 0; -is( getParentType($mock), undef, - '... but should return false if it fails (underived nodetype)' ); +sub test_get_default_type_permissions :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->{derived_defaultauthoraccess} = 'hi, i am the author'; -# hasTypeAccess() -$mock->set_always( getNode => $mock )->set_always( hasAccess => 'acc' ) - ->clear(); + is( $node->getDefaultTypePermissions( 'author' ), + $node->{derived_defaultauthoraccess}, + 'getDefaultTypePermissions() should return derived class permissions' ); + ok( ! $node->getDefaultTypePermissions( 'fakefield' ), + '... should return false if field does not exist'); + ok( ! exists $node->{derived_defaultfakefieldaccess}, + '... and should not autovivify bad field' ); +} -hasTypeAccess( $mock, 'user', 'modes' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'getNode', 'hasTypeAccess() should fetch node to check perms' ); -is( - join( '-', @$args ), - "$mock-dummy_access_node-$mock-create force", - '... forcing a dummy nodetype node' -); -( $method, $args ) = $mock->next_call(); -is( $method, 'hasAccess', '... checking access on result' ); -is( join( '-', @$args ), "$mock-user-modes", '... for user and permissions' ); +sub test_get_parent_type :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; -# isGroupType() -is( - isGroupType($mock), - $mock->{derived_grouptable}, - 'isGroupType() should return "derived_grouptable" if it exists' -); -delete $mock->{derived_grouptable}, - is( isGroupType($mock), undef, '... and false if it does not' ); + $db->set_always( getType => 88 ); + $node->{extends_nodetype} = 77; -# derivesFrom() -$mock->set_series( - getType => 0, - { type_nodetype => 2 }, - { type_nodetype => 1, node_id => 88 }, - { type_nodetype => 1, node_id => 99 } -)->set_always( getParentType => $mock )->clear(); + my $result = $node->getParentType(); + my ( $method, $args ) = $db->next_call(); + is( $method, 'getType', + 'getParentType() should get parent type, if it exists' ); + is( $args->[1], 77, '... with the parent id' ); + is( $result, 88, '... returning it' ); -$result = derivesFrom( $mock, 'foo' ); -is( $mock->next_call(), 'getType', - 'derivesFrom() should find the type of the first parameter' ); -is( $result, 0, '... returning 0 unless it exists' ); + $node->{extends_nodetype} = 0; + is( $node->getParentType(), undef, + '... but should return false if it fails (underived nodetype)' ); +} -is( derivesFrom( $mock, 'bar' ), 0, '... or if it is not a nodetype node' ); +sub test_has_type_access :Test( 5 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $db->set_always( getNode => $node ); + $node->set_always( hasAccess => 'acc' ); -$mock->{node_id} = 77; -my $gpt = 0; + my $result = $node->hasTypeAccess( 'user', 'modes' ); + my ( $method, $args ) = $db->next_call(); + is( $method, 'getNode', 'hasTypeAccess() should fetch access node' ); + is( join( '-', @$args ), "$db-dummy_access_node-$node-create force", + '... forcing a dummy nodetype node' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'hasAccess', '... checking access on result' ); + is( join( '-', @$args ), "$node-user-modes", '... for user and perms' ); + is( $result, 'acc', '... returning result' ); +} + +sub test_is_group_type :Test( 2 ) { - $mock->mock( - getParentType => sub { - return if $gpt; - $gpt = 1; - $mock->{node_id} = 88; - return $mock; - } + my $self = shift; + my $node = $self->{node}; + + ok( ! $node->isGroupType(), + 'isGroupType() should return false unless "derived_grouptable" exists'); + + $node->{derived_grouptable} = 648; + is( $node->isGroupType(), 648, + '... and should return "derived_grouptable" if it exists' ); +} + +sub test_derives_from :Test( 6 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $db->set_series( + getType => 0, + { type_nodetype => 2 }, + { type_nodetype => 1, node_id => 88 }, + { type_nodetype => 1, node_id => 99 } ); - $result = derivesFrom( $mock, 'theboatashore' ); + + $node->set_always( getParentType => $node ); + + my $result = $node->derivesFrom( 'foo' ); + is( $db->next_call(), 'getType', + 'derivesFrom() should find the type of the first parameter' ); + is( $result, 0, '... returning 0 unless it exists' ); + + is( $node->derivesFrom( 'bar' ), 0, '... or if it is not a nodetype node' ); + + $node->{node_id} = 77; + my $gpt = 0; + { + $node->mock( + getParentType => sub { + return if $gpt; + $gpt = 1; + $node->{node_id} = 88; + return $node; + } + ); + $result = $node->derivesFrom( 'theboatashore' ); + } + ok( $gpt, '... should walk up hierarchy with getParentType() as needed' ); + is( $result, 1, '... returning true if the nodes are related' ); + is( $node->derivesFrom( '' ), 0, '... and false otherwise' ); } -ok( $gpt, '... and should walk up hierarchy with getParentType() as needed' ); -is( $result, 1, '... returning true if the nodes are related' ); -is( derivesFrom( $mock, '' ), 0, '... and false otherwise' ); -# getNodeKeepKeys() -$mock->set_always( SUPER => { foo => 1 } )->clear(); +sub test_get_node_keep_keys :Test( 5 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; -$result = getNodeKeepKeys($mock); -is( $mock->next_call(), 'SUPER', 'getNodeKeepKeys() should call SUPER()' ); -is( ref $result, 'HASH', '... and should return a hash reference' ); -is( scalar grep( /default.+access/, keys %$result ), - 4, '... and should save class access keys' ); -is( $result->{defaultgroup_usergroup}, 1, '... and the default usergroup key' ); -is( scalar grep( /default.+permission/, keys %$result ), - 4, '... and default class permission keys' ); + $node->set_always( SUPER => { foo => 1 } ); + + my $result = $node->getNodeKeepKeys(); + is( $node->next_call(), 'SUPER', 'getNodeKeepKeys() should call SUPER()' ); + is( ref $result, 'HASH', '... and should return a hash reference' ); + is( grep( /default.+access/, keys %$result ), 4, + '... and should save class access keys' ); + is( $result->{defaultgroup_usergroup}, 1, + '... and the default usergroup key' ); + is( grep( /default.+permission/, keys %$result ), 4, + '... and default class permission keys' ); +} + +1; Modified: trunk/ebase/t/Node/nodetype.t =================================================================== --- trunk/ebase/t/Node/nodetype.t 2006-04-14 00:13:31 UTC (rev 843) +++ trunk/ebase/t/Node/nodetype.t 2006-04-14 23:29:29 UTC (rev 844) @@ -1,296 +1,7 @@ -#!/usr/bin/perl +#! perl use strict; use warnings; -=cut - use Everything::Node::Test::nodetype; Everything::Node::Test::nodetype->runtests(); - -=cut - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::MockObject; -use Test::More tests => 57; - -use vars '$AUTOLOAD'; - -my $module = 'Everything::Node::nodetype'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::node' ), 'nodetype should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( nodetype node )], - 'dbtables() should return node tables' ); - -sub AUTOLOAD -{ - return if $AUTOLOAD =~ /DESTROY$/; - - no strict 'refs'; - $AUTOLOAD =~ s/^main:://; - - if ( my $sub = $module->can( $AUTOLOAD ) ) - { - *{$AUTOLOAD} = $sub; - goto &$sub; - } -} - -my $mock = Test::MockObject->new(); -$mock->fake_module('Everything::Security'); - -my ( $method, $args, $result ); - -# construct() -$mock->set_true('SUPER')->set_true('finish'); - -$mock->{node_id} = $mock->{extends_nodetype} = 0; -$mock->{sqltable} = 'foo,bar,baz'; - -ok( construct($mock), 'construct() should always succeed (unless it dies)' ); -is( $mock->next_call(), 'SUPER', '... should call SUPER()' ); -isa_ok( $mock->{tableArray}, 'ARRAY', - '... storing necessary tables in "tableArray" field as something that' ); - -$mock->{node_id} = 1; -$mock->{DB} = $mock->{dbh} = $mock; -$mock->set_always( sqlSelect => 1 )->set_always( sqlSelectJoined => $mock ) - ->set_always( fetchrow_hashref => $mock )->clear(); - -@$mock{ - qw( - defaultguest_permission defaultguestaccess defaultgroupaccess - defaultauthoraccess canworkspace maxrevisions defaultauthor_permission - defaultgroup_permission defaultgroup_usergroup defaultotheraccess - defaultother_permission grouptable - ) - } - = ('') x 12; - -construct($mock); -is( $mock->{type}, $mock, '... should set node number 1 type to itself' ); - -( $method, $args ) = $mock->next_call(2); -is( $method, 'sqlSelect', '... fetching a node if the node_id is 1' ); -is( - join( '-', @$args ), - "$mock-node_id-node-title='node' AND type_nodetype=1", - '... with the appropriate parameters' -); - -( $method, $args ) = $mock->next_call(); -is( $method, 'sqlSelectJoined', '... fetching its nodetype data' ); -like( - join( ' ', @$args ), - qr/\* nodetype.+nodetype_id=/, - '... with the appropriate arguments' -); -is( $mock->next_call(), 'fetchrow_hashref', - '... populating nodetype node with nodetype data' ); - -my @fields = - qw( sqltable maxrevisions canworkspace grouptable defaultgroup_usergroup ); -@$mock{@fields} = ('') x @fields; - -foreach my $class (qw( author group guest other )) -{ - my @classfields = ( "default${class}access", "default${class}_permission" ); - push @fields, @classfields; - @$mock{@classfields} = ( -1, -1 ); -} - -$mock->{extends_nodetype} = $mock->{node_id} = 6; - -my $parent = { map { $_ => $_, "derived_$_" => $_ } @fields }; -$parent->{derived_defaultguestaccess} = 100; -$mock->{defaultguestaccess} = 1; -$parent->{derived_sqltable} = 'boo,far'; - -$mock->set_always( getNode => $parent ); - -my $ip; -{ - local *Everything::Security::inheritPermissions; - *Everything::Security::inheritPermissions = sub { - $ip = join( ' ', @_ ); - }; - - construct($mock); -} - -( $method, $args ) = $mock->next_call(3); -is( $method, 'getNode', '... fetching nodetype data, if necessary' ); -is( $args->[1], 6, '... for parent' ); -is( $mock->{derived_grouptable}, - 'grouptable', '... should copy derived fields if they are inherited' ); - -# misleading, I know... -is( $mock->{defaultgroupaccess}, -1, '... but should not copy other fields' ); -is( $ip, '1 100', - '... should call inheritPermissions() for permission fields' ); -is( $mock->{derived_sqltable}, - 'boo,far', '... should add sqltable fields to the list' ); -is( $mock->{derived_grouptable}, - 'grouptable', - '... should use parent grouptable if none more specific exists' ); - -# destruct() -$mock->{tableArray} = 1; -destruct($mock); -ok( !exists $mock->{tableArray}, - 'destruct() should remove "tableArray" field' ); - -# insert() -$mock->set_series( getType => map { { node_id => $_ } } ( 11, 12, 11 ) ) - ->clear(); - -delete $mock->{extends_nodetype}; -insert($mock); -is( $mock->call_pos(-1), 'SUPER', 'insert() should call SUPER()' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'getType', '... with no parent should extend a type' ); -is( $args->[1], 'node', '... the node type, by default' ); - -$mock->{extends_nodetype} = 0; -insert($mock); -is( $mock->{extends_nodetype}, 12, '... or if the parent is 0' ); - -# make it extend itself, should not work -$mock->{type_nodetype} = 12; -$mock->{DB}{cache} = $mock; - -insert($mock); -isnt( $mock->{extends_nodetype}, - 12, '... and should not be allowed to extend itself' ); - -# update() -$mock->set_series( SUPER => undef, 47 )->set_true('flushCacheGlobal')->clear(); -update($mock); -is( $mock->next_call(), 'SUPER', 'update() should call SUPER()' ); - -$mock->{cache} = $mock; -$result = update($mock); -is( $result, 47, '... and return the results' ); -is( $mock->next_call(2), 'flushCacheGlobal', - '... flushing the global cache, if SUPER() is successful' ); - -# nuke() - -# getTableArray() -$mock->{tableArray} = [ 1 .. 4 ]; -$result = getTableArray($mock); -is( ref $result, 'ARRAY', - 'getTableArray() should return array ref to "tableArray" field' ); -is( scalar @$result, 4, '... and should contain all items' ); -ok( !grep( { $_ eq 'node' } @$result ), - '... should not provide "node" table with no arguments' ); -is( getTableArray( $mock, 1 )->[-1], - 'node', '... but should happily provide it with $mockTable set to true' ); - -# getDefaultTypePermissions() -is( - getDefaultTypePermissions( $mock, 'author' ), - $mock->{derived_defaultauthoraccess}, - 'getDefaultTypePermissions() should return derived permissions for class' -); -ok( - !getDefaultTypePermissions( $mock, 'fakefield' ), - '... should return false if field does not exist' -); -ok( - !exists $mock->{derived_defaultfakefieldaccess}, - '... and should not autovivify bad field' -); - -# getParentType() -$mock->set_always( getType => 88 )->clear(); - -$mock->{extends_nodetype} = 77; -$result = getParentType($mock); -( $method, $args ) = $mock->next_call(); -is( $method, 'getType', - 'getParentType() should get parent type from the database, if it exists' ); -is( $args->[1], 77, '... with the parent id' ); -is( $result, 88, '... returning it' ); - -$mock->{extends_nodetype} = 0; -is( getParentType($mock), undef, - '... but should return false if it fails (underived nodetype)' ); - -# hasTypeAccess() -$mock->set_always( getNode => $mock )->set_always( hasAccess => 'acc' ) - ->clear(); - -hasTypeAccess( $mock, 'user', 'modes' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'getNode', 'hasTypeAccess() should fetch node to check perms' ); -is( - join( '-', @$args ), - "$mock-dummy_access_node-$mock-create force", - '... forcing a dummy nodetype node' -); -( $method, $args ) = $mock->next_call(); -is( $method, 'hasAccess', '... checking access on result' ); -is( join( '-', @$args ), "$mock-user-modes", '... for user and permissions' ); - -# isGroupType() -is( - isGroupType($mock), - $mock->{derived_grouptable}, - 'isGroupType() should return "derived_grouptable" if it exists' -); -delete $mock->{derived_grouptable}, - is( isGroupType($mock), undef, '... and false if it does not' ); - -# derivesFrom() -$mock->set_series( - getType => 0, - { type_nodetype => 2 }, - { type_nodetype => 1, node_id => 88 }, - { type_nodetype => 1, node_id => 99 } -)->set_always( getParentType => $mock )->clear(); - -$result = derivesFrom( $mock, 'foo' ); -is( $mock->next_call(), 'getType', - 'derivesFrom() should find the type of the first parameter' ); -is( $result, 0, '... returning 0 unless it exists' ); - -is( derivesFrom( $mock, 'bar' ), 0, '... or if it is not a nodetype node' ); - -$mock->{node_id} = 77; -my $gpt = 0; -{ - $mock->mock( - getParentType => sub { - return if $gpt; - $gpt = 1; - $mock->{node_id} = 88; - return $mock; - } - ); - $result = derivesFrom( $mock, 'theboatashore' ); -} -ok( $gpt, '... and should walk up hierarchy with getParentType() as needed' ); -is( $result, 1, '... returning true if the nodes are related' ); -is( derivesFrom( $mock, '' ), 0, '... and false otherwise' ); - -# getNodeKeepKeys() -$mock->set_always( SUPER => { foo => 1 } )->clear(); - -$result = getNodeKeepKeys($mock); -is( $mock->next_call(), 'SUPER', 'getNodeKeepKeys() should call SUPER()' ); -is( ref $result, 'HASH', '... and should return a hash reference' ); -is( scalar grep( /default.+access/, keys %$result ), - 4, '... and should save class access keys' ); -is( $result->{defaultgroup_usergroup}, 1, '... and the default usergroup key' ); -is( scalar grep( /default.+permission/, keys %$result ), - 4, '... and default class permission keys' ); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-04-15 00:45:20
|
Revision: 845 Author: chromatic Date: 2006-04-14 17:44:59 -0700 (Fri, 14 Apr 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=845&view=rev Log Message: ----------- r15762@windwheel: chromatic | 2006-04-14 17:44:43 -0700 Ported setting tests to Test::Class. Added reset_mock_node() to node test class. Added skips to other tests to handle new SUPER() behavior in setting node. Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/node.pm trunk/ebase/lib/Everything/Node/setting.pm trunk/ebase/t/Node/setting.t trunk/ebase/t/Node/themesetting.t trunk/ebase/t/Node/user.t trunk/ebase/t/Node/workspace.t Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15760 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15762 Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-14 23:29:29 UTC (rev 844) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-15 00:44:59 UTC (rev 845) @@ -58,17 +58,22 @@ sub make_fixture :Test(setup) { my $self = shift; - $self->{mock} = Test::MockObject->new(); - my $node = $self->node_class()->new(); - $self->{node} = Test::MockObject::Extends->new( $node ); my $db = Test::MockObject->new(); + $self->reset_mock_node(); *Everything::Node::node::DB = \$db; $self->{mock_db} = $db; - $node->{DB} = $db; + $self->{node}{DB} = $db; $self->{errors} = []; } +sub reset_mock_node +{ + my $self = shift; + my $node = $self->node_class()->new(); + $self->{node} = Test::MockObject::Extends->new( $node ); +} + sub test_construct :Test( 1 ) { my $self = shift; @@ -412,7 +417,7 @@ my $self = shift; my $node = $self->{node}; - $node->set_series( getTagName => 'badtag', 'field', 'morefield' )->clear(); + $node->set_always( getTagName => 'badtag' ); $node->{type} = $node; $node->{title} = 'thistype'; @@ -422,14 +427,16 @@ like( $self->{errors}[0][1], qr/tag 'badtag'.+'thistype'/, '... logging an error' ); - local *Everything::XML::parseBasicTag; my @pbt; my $parse = { name => 'parsed', parsed => 11 }; + + local *Everything::XML::parseBasicTag; *Everything::XML::parseBasicTag = sub { push @pbt, [@_]; return $parse; }; + $node->set_series( getTagName => 'field', 'morefield' ); $result = $node->xmlTag( $node ); is( join( ' ', @{ $pbt[0] } ), "$node node", '... should parse tag' ); is( $result, undef, '... should return false with no fixes' ); @@ -502,7 +509,7 @@ my $node = $self->{node}; my $where = { title => 'title', type_nodetype => 'type', field => 'b' }; - my $fix = { where => $where, field => 'fixme', title => '' }; + my $fix = { where => $where, field => 'fixme', title => '' }; is( $node->applyXMLFix( $fix ), $fix, 'applyXMLFix() should return fix if it has no "fixBy" field' ); Modified: trunk/ebase/lib/Everything/Node/setting.pm =================================================================== --- trunk/ebase/lib/Everything/Node/setting.pm 2006-04-14 23:29:29 UTC (rev 844) +++ trunk/ebase/lib/Everything/Node/setting.pm 2006-04-15 00:44:59 UTC (rev 845) @@ -28,7 +28,7 @@ sub dbtables { my $self = shift; - return 'setting', $self->SUPER::dbtables(); + return 'setting', $self->SUPER( @_ ); } =head2 C<getVars> @@ -109,7 +109,7 @@ my ( $this, $DOC, $field, $indent ) = @_; $indent ||= ''; - return $this->SUPER() unless $field eq 'vars'; + return $this->SUPER( $DOC, $field, $indent ) unless $field eq 'vars'; my $VARS = XML::DOM::Element->new( $DOC, "vars" ); my $vars = $this->getVars(); @@ -133,9 +133,9 @@ sub xmlTag { my ( $this, $TAG ) = @_; - my $tagname = $TAG->getTagName(); + my $tagname = $TAG->getTagName(); - return $this->SUPER() unless $tagname eq 'vars'; + return $this->SUPER( $TAG ) unless $tagname eq 'vars'; my @fixes; my @childFields = $TAG->getChildNodes(); @@ -179,10 +179,10 @@ for my $required (qw( fixBy field where )) { - return unless exists $FIX->{$required}; + return $FIX unless exists $FIX->{$required}; } - return $this->SUPER() unless $FIX->{fixBy} eq 'setting'; + return $this->SUPER( $FIX, $printError ) unless $FIX->{fixBy} eq 'setting'; my $vars = $this->getVars(); my $where = Everything::XML::patchXMLwhere( $FIX->{where} ); Modified: trunk/ebase/t/Node/setting.t =================================================================== --- trunk/ebase/t/Node/setting.t 2006-04-14 23:29:29 UTC (rev 844) +++ trunk/ebase/t/Node/setting.t 2006-04-15 00:44:59 UTC (rev 845) @@ -1,228 +1,7 @@ -#!/usr/bin/perl -w +#! perl use strict; use warnings; -use vars '$AUTOLOAD'; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 45; - -use TieOut; -use Test::MockObject::Extends; - -my $module = 'Everything::Node::setting'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::node' ), 'setting should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( setting node )], - 'dbtables() should return node tables' ); - -for my $class ( - qw( Everything::Security Everything::Util Everything::XML XML::DOM ) -) { - (my $path = $class) =~ s{::}{/}g; - ok( $INC{ $path . '.pm' }, "$module should load $class" ); -} - -my $node = Test::MockObject::Extends->new( 'Everything::Node::setting' ); - -# construct() -ok( $node->construct(), 'construct() should return a true value' ); - -# destruct() -is( $node->destruct(), 1, 'destruct() should delegate to SUPER()' ); - -# getVars() -$node->set_always( getHash => { foo => 'bar' } ); -is_deeply( $node->getVars($node), - { foo => 'bar' }, 'getVars() should call getHash() on node' ); -is( ( $node->next_call() )[1]->[1], 'vars', '... with "vars" argument' ); - -$node->set_true( 'setHash' ); -# setVars() -$node->setVars( { my => 'vars' } ); -my ($method, $args) = $node->next_call(); -is( $method, 'setHash', 'setVars() should call setHash()' ); -is_deeply( $args->[1], { my => 'vars' }, '... with hash arguments' ); - -# hasVars() -ok( $node->hasVars(), 'hasVars() should return true' ); - - -# fieldToXML() -{ - local ( *XML::DOM::Element::new, *XML::DOM::Text::new, - *Everything::Node::setting::genBasicTag, *fieldToXML ); - - my @dom; - *XML::DOM::Element::new = *XML::DOM::Text::new = sub { - push @dom, shift; - return $node; - }; - - my @tags; - *Everything::Node::setting::genBasicTag = sub { - push @tags, join( ' ', @_[ 1 .. 3 ] ); - }; - - *fieldToXML = \&Everything::Node::setting::fieldToXML; - - $node->set_always( getVars => { a => 1, b => 1, c => 1 } ) - ->set_series( SUPER => 2, 10 ) - ->set_true( '-appendChild' ); - - is( - $node->fieldToXML( '', '', '!' ), - 2, - 'fieldToXML() should delegate to SUPER() unless field param is "vars"' - ); - - $node->clear(); - is( $node->fieldToXML( '', 'vars' ), - $node, '... should return XML::DOM element for vars, if "vars" field' ); - is( @dom, 5, '... should make several DOM nodes:' ); - is( scalar grep( /Element/, @dom ), 1, '... one Element node' ); - is( scalar grep( /Text/, @dom ), 4, '... and several Text nodes' ); - - is( - join( '!', @tags ), - 'var a 1!var b 1!var c 1', - '... should call genBasicTag() on each var pair' - ); - - # could check $indent and $indentchild -} -# xmlTag() -{ - local *XML::DOM::TEXT_NODE; - *XML::DOM::TEXT_NODE = sub () { 1 }; - - $node->set_always( -SUPER => 3 ); - $node->set_series( -getTagName => '', 'vars' ); - $node->set_series( -getVars => ($node) x 3 ); - $node->set_series( -getChildNodes => ($node) x 3 ); - $node->set_series( getNodeType => 1, 0, 0 ); - $node->set_true( 'setVars' ); - $node->clear(); - - my @types = ( { where => 'foo', name => 'foo' }, { name => 'bar' } ); - local *Everything::Node::setting::parseBasicTag; - *Everything::Node::setting::parseBasicTag = sub { - return shift @types; - }; - - is( $node->xmlTag( $node ), 3, - 'xmlTag() should delegate to SUPER() unless passed "vars" tag' ); - - $node->{vars} = { foo => -1, bar => 1 }; - my $fixes = Everything::Node::setting::xmlTag( $node, $node ); - ok( exists $node->{vars}, - '... should vivify "vars" field in node when "vars" is requested' ); - is( @$fixes, 1, '... and return array ref of fixable nodes' ); - is( $node->{vars}{ $fixes->[0]{where} }, - -1, '... and should mark fixable nodes by name in "vars"' ); - is( $node->{vars}{bar}, 1, '... and keep tag value for fixed tags' ); - my ($method, $args) = $node->next_call( 2 ); - is( join( ' ', $method, $args->[1] ), "setVars $node", - '... and should call setVars() to keep them' ); -} - -# applyXMLFix() -{ - local ( *Everything::XML::patchXMLwhere, *Everything::logErrors ); - my $patch; - *Everything::XML::patchXMLwhere = sub - { - $patch = shift; - return { type_nodetype => 'nodetype' }; - }; - - my @errors; - *Everything::logErrors = sub - { - push @errors, join( ' ', @_ ); - }; - - is( $node->applyXMLFix(), undef, - 'applyXMLFix() should return if called without a fix' ); - is( $node->applyXMLFix( 'bad' ), undef, '... or with a bad fix' ); - my $fix = {}; - foreach my $key (qw( fixBy field where )) - { - is( $node->applyXMLFix( $fix ), undef, "... or without a '$key' key" ); - $fix->{$key} = ''; - } - - $node->set_always( 'SUPER', 'duper' ); - is( $node->applyXMLFix( $fix ), 'duper', '... or unless fixing a setting' ); - is( $node->next_call(), 'SUPER', '... and delegate to SUPER() ' ); - - $node->set_series( getVars => ( $node ) x 3 ); - $node->set_series( getNode => 0, 0, { node_id => 888 } ); - $node->{DB} = $node; - - @$fix{ 'fixBy', 'where' } = ( 'setting', 'w' ); - isa_ok( $node->applyXMLFix( $fix ), - 'HASH', '... should return setting $FIX if it cannot be found' ); - is( $patch, 'w', - '... should call patchXMLwhere() with "where" field of FIX' ); - - $node->{title} = 'node title'; - $node->{nodetype}{title} = 'nodetype title'; - - local *STDOUT; - my $out = tie *STDOUT, 'TieOut'; - - $node->applyXMLFix( - { - field => 'field', - fixBy => 'setting', - title => 'title', - type_nodetype => 'type', - where => 1, - }, - 1 - ); - - like( - $errors[0], - qr/Unable to find 'title'.+'type'.+field/s, - '... should print error if node is not found and printError is true' - ); - - $node->{node_id} = 0; - $fix->{field} = 'foo'; - - $node->clear(); - is( $node->applyXMLFix( $fix ), undef, - 'applyXMLFix() should return undef if successfully called for setting' - ); - is( $node->{foo}, 888, '... and set variable for field to node_id' ); - my ($method, $args) = $node->next_call( 3 ); - is( join( ' ', $method, $args->[1] ), "setVars $node", - '... and should call setVars() to save vars' - ); -} - -# getNodeKeepKeys() -$node->set_always( SUPER => $node ); -is( $node->getNodeKeepKeys(), $node, 'getNodeKeepKeys() should call SUPER()' ); -is( $node->{vars}, 1, '... and should set "vars" to true in results' ); - -# updateFromImport() -$node->set_always( -SUPER => 10 ); -$node->set_series( -getVars => { a => 1, b => 2 }, $node ); -$node->clear(); -is( $node->updateFromImport( $node ), - 10, 'updateFromImport() should call SUPER()' ); -is( $node->next_call(), 'setVars', '... and should call setVars()' ); -is( join( '', @$node{ 'a', 'b' } ), '12', '... and merge keys from new node' ); +use Everything::Node::Test::setting; +Everything::Node::Test::setting->runtests(); Modified: trunk/ebase/t/Node/themesetting.t =================================================================== --- trunk/ebase/t/Node/themesetting.t 2006-04-14 23:29:29 UTC (rev 844) +++ trunk/ebase/t/Node/themesetting.t 2006-04-15 00:44:59 UTC (rev 845) @@ -10,6 +10,9 @@ } use Test::More tests => 4; +use SUPER; +local *Everything::Node::setting::SUPER; +*Everything::Node::setting::SUPER = \&UNIVERSAL::SUPER; my $module = 'Everything::Node::themesetting'; use_ok( $module ) or exit; Modified: trunk/ebase/t/Node/user.t =================================================================== --- trunk/ebase/t/Node/user.t 2006-04-14 23:29:29 UTC (rev 844) +++ trunk/ebase/t/Node/user.t 2006-04-15 00:44:59 UTC (rev 845) @@ -20,9 +20,13 @@ ok( $module->isa( 'Everything::Node::setting' ), 'user should extend setting' ); can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( user document setting node )], - 'dbtables() should return node tables' ); +SKIP: +{ + skip( 'SUPER not appropriate yet', 1 ); + my @tables = $module->dbtables(); + is_deeply( \@tables, [qw( user document setting node )], + 'dbtables() should return node tables' ); +} sub AUTOLOAD { Modified: trunk/ebase/t/Node/workspace.t =================================================================== --- trunk/ebase/t/Node/workspace.t 2006-04-14 23:29:29 UTC (rev 844) +++ trunk/ebase/t/Node/workspace.t 2006-04-15 00:44:59 UTC (rev 845) @@ -19,9 +19,13 @@ 'workspace should extend setting' ); can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( setting node )], - 'dbtables() should return node tables' ); +SKIP: +{ + skip( 'SUPER not appropriate yet', 1 ); + my @tables = $module->dbtables(); + is_deeply( \@tables, [qw( setting node )], + 'dbtables() should return node tables' ); +} my $node = FakeNode->new(); $node->{_subs}{hasAccess} = [ undef, 1 ]; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-04-21 00:20:38
|
Revision: 846 Author: chromatic Date: 2006-04-20 17:20:21 -0700 (Thu, 20 Apr 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=846&view=rev Log Message: ----------- r15990@windwheel: chromatic | 2006-04-20 17:20:09 -0700 Ported user node tests to Test::Class. Updated Build.PL with new dependencies on SUPER and Test::MockObject::Extends. Modified Paths: -------------- trunk/ebase/Build.PL trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/Test/node.pm trunk/ebase/lib/Everything/Node/user.pm trunk/ebase/t/Node/user.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/user.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15762 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15990 Modified: trunk/ebase/Build.PL =================================================================== --- trunk/ebase/Build.PL 2006-04-15 00:44:59 UTC (rev 845) +++ trunk/ebase/Build.PL 2006-04-21 00:20:21 UTC (rev 846) @@ -35,11 +35,12 @@ 'Mail::Address' => 1.53, 'Mail::Sender' => 0, 'Scalar::Util' => 1.01, + 'SUPER' => 1.12, }, build_requires => { 'Test::Class' => 0.11, - 'Test::MockObject' => 0.11, + 'Test::MockObject' => 1.05, 'Test::Exception' => 0.13, 'Test::Simple' => 0.47, }, Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-04-15 00:44:59 UTC (rev 845) +++ trunk/ebase/MANIFEST 2006-04-21 00:20:21 UTC (rev 846) @@ -89,6 +89,7 @@ lib/Everything/Node/workspace.pm lib/Everything/Node/Test/node.pm lib/Everything/Node/Test/nodetype.pm +lib/Everything/Node/Test/user.pm lib/Everything/Nodeball.pm lib/Everything/NodeBase.pm lib/Everything/NodeBase/mysql.pm Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-15 00:44:59 UTC (rev 845) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-04-21 00:20:21 UTC (rev 846) @@ -11,9 +11,10 @@ use Scalar::Util 'reftype'; +local *Everything::Node::SUPER = \&UNIVERSAL::SUPER; sub node_class { 'Everything::Node::node' } -sub startup :Test( startup => 4 ) +sub startup :Test( startup => 3 ) { my $self = shift; $self->{errors} = []; @@ -38,14 +39,20 @@ use_ok( $module ) or exit; - ok( $module->isa( 'Everything::Node' ), - "$module should extend Everything::Node" ); - # now test that C<new()> works can_ok( $module, 'new' ); isa_ok( $module->new(), $module ); } +sub test_extends :Test( 1 ) +{ + my $self = shift; + my $module = $self->node_class(); + + ok( $module->isa( 'Everything::Node' ), + "$module should extend Everything::Node" ); +} + sub test_dbtables :Test( 2 ) { my $self = shift; Added: trunk/ebase/lib/Everything/Node/Test/user.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/user.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/user.pm 2006-04-21 00:20:21 UTC (rev 846) @@ -0,0 +1,226 @@ +package Everything::Node::Test::user; + +use strict; +use warnings; + +use SUPER; +use Scalar::Util 'reftype'; + +use Test::More; + +*Everything::Node::user::SUPER = \&UNIVERSAL::SUPER; + +use base 'Everything::Node::Test::node'; + +sub node_class { 'Everything::Node::user' } + +sub test_extends :Test( +1 ) +{ + my $self = shift; + my $module = $self->node_class(); + ok( $module->isa( 'Everything::Node::setting' ), + "$module should extend setting node" ); + $self->SUPER(); +} + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $node = $self->{node}; + my @result = $node->dbtables(); + is( $result[0], 'user', 'dbtables() should return array of user...' ); + is( $result[1], 'document', '... and document as first tables' ); +} + +sub test_insert :Test( 5 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_series( -SUPER => 0, 10, 10 ) + ->set_true( 'update' ); + + $node->{title} = 'foo'; + + ok( ! $node->insert( 'user' ), + 'insert() should return false if SUPER call fails' ); + + is( $node->insert( 'user' ), 10, + '... should return inserted node_id on success' ); + + my ( $method, $args ) = $node->next_call(); + is( $method, 'update', '... then calling update()' ); + is( $args->[1], 'user', '... with the user' ); + is( $node->{author_user}, 10, + '... and seting "author_user" to inserted node_id' ); +} + +sub test_insert_restrict_dupes :Test( +0 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->set_true( -update ); + $self->SUPER(); +} + +sub test_insert_restrictions :Test( +0 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->set_true( -update ); + $self->SUPER(); +} + +sub test_is_god :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $db->set_series( getNode => 0, ($node) x 2 ); + $node->set_always( inGroup => 'inGroup' ) + ->set_always( inGroupFast => 'inGroupFast' ); + + ok( ! $node->isGod(), + 'isGod() should return false unless it can find gods usergroup' ); + + is( $node->isGod(), 'inGroupFast', + '... should call inGroupFast() without recurse flag' ); + is( $node->isGod( 1 ), 'inGroup', '... and inGroup() with it' ); +} + +sub test_is_guest :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + my @newnodes = + ( + bless( { guest_user => 0 }, 'FakeNode' ), + bless( { guest_user => 1 }, 'FakeNode' ) + ); + + $db->set_series( getNode => 0, ($node) x 2 ); + $node->set_series( getVars => undef, @newnodes ); + + ok( $node->isGuest(), + 'isGuest() should return true unless it can get system settings node' ); + + ok( $node->isGuest(), + '... should return true unless it can get system settings node' ); + + $node->{node_id} = 1; + + ok( ! $node->isGuest(), '... should return false unless node_ids match' ); + ok( $node->isGuest(), '... and true if they do' ); +} + +sub test_get_node_keys :Test( +5 ) +{ + my $self = shift; + my $node = $self->{node}; + my %keys = map { $_ => 1 } qw( passwd lasttime title foo_id ); + + $node->set_always( getNodeDatabaseHash => \%keys ); + + my $keys = $node->getNodeKeys(); + is( reftype($keys), 'HASH', 'getNodeKeys() should return a hash' ); + is( $keys->{passwd}, 1, '... not deleting password if not exporting' ); + is( $keys->{lasttime}, 1, '... nor time of most recent activity' ); + + $keys = $node->getNodeKeys( 1 ); + ok( !exists $keys->{passwd}, '... but should delete "passwd"' ); + ok( !exists $keys->{lasttime}, '... and "lasttime" if exporting' ); + $self->SUPER(); +} + +sub test_verify_field_update :Test( 5 ) +{ + my $self = shift; + my $node = $self->{node}; + + for my $field (qw( title karma lasttime )) + { + ok( ! $node->verifyFieldUpdate( $field ), + "verifyFieldUpdate should return false for '$field' field" ); + } + + $node->set_series( SUPER => 1, 0 ); + + ok( $node->verifyFieldUpdate( 'absent' ), + '... should return false if SUPER() call does' ); + + ok( !$node->verifyFieldUpdate( 'title' ), + '... and false if field is restricted here, but not in parent' ); +} + +sub test_conflicts_with :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; + ok( ! $node->conflictsWith(), 'conflictsWith() should return false' ); +} + +sub test_update_from_import :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; + ok( ! $node->updateFromImport(), 'updateFromImport() should return false' ); +} + +sub test_restrict_title :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + + ok( ! $node->restrictTitle(), + 'restrictTitle() should return false with no title' ); + + $node->{title} = 'foo|'; + ok( ! $node->restrictTitle(), '... or false with bad chars in title' ); + + $node->{title} = 'some user_name'; + ok( $node->restrictTitle(), '... or true if it has only good chars' ); +} + +sub test_get_nodelets :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + my $nodelets = { nodelets => '1,2,4' }; + + $node->set_always( getVars => $nodelets ); + is_deeply( $node->getNodelets(), [ 1, 2, 4 ], + 'getNodelets() should return existing nodelets vars in array ref' ); + + delete $nodelets->{nodelets}; + $db->set_always( getNode => $node ); + $node->set_series( isOfType => 1, 0 ); + + $nodelets->{nodelet_group} = $node; + $node->{group} = [ 4, 2, 1 ]; + is_deeply( $node->getNodelets(), [ 4, 2, 1 ], + '... or from user nodelet group, if specified' ); + + delete $nodelets->{nodelet_group}; + + $node->{group} = [ 8, 6, 1 ]; + + is_deeply( $node->getNodelets( 'default' ), [ 8, 6, 1 ], + '... or from default group' ); +} + +# XXX - delete me soon +sub test_has_vars :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; + ok( $node->hasVars(), 'user node should have vars' ); +} + +# XXX - delete soon +sub test_xml_tag :Test(+0) {} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/user.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/user.pm =================================================================== --- trunk/ebase/lib/Everything/Node/user.pm 2006-04-15 00:44:59 UTC (rev 845) +++ trunk/ebase/lib/Everything/Node/user.pm 2006-04-21 00:20:21 UTC (rev 846) @@ -23,7 +23,7 @@ sub dbtables { my $self = shift; - return qw( user document ), $self->SUPER::dbtables(); + return qw( user document ), $self->SUPER(); } =head2 C<insert> @@ -36,7 +36,7 @@ { my ( $this, $USER ) = @_; - my $id = $this->SUPER() or return; + return 0 unless my $id = $this->SUPER(); # Make all new users default to owning themselves. $this->{author_user} = $id; @@ -99,7 +99,7 @@ sub getNodeKeys { my ( $this, $forExport ) = @_; - my $keys = $this->SUPER(); + my $keys = $this->SUPER( $forExport ); # Remove these fields if we are exporting user nodes. delete @$keys{qw( passwd lasttime )} if $forExport; @@ -117,7 +117,8 @@ { my ( $this, $field ) = @_; - my $restrictedFields = { + my $restrictedFields = + { title => 1, karma => 1, lasttime => 1, Modified: trunk/ebase/t/Node/user.t =================================================================== --- trunk/ebase/t/Node/user.t 2006-04-15 00:44:59 UTC (rev 845) +++ trunk/ebase/t/Node/user.t 2006-04-21 00:20:21 UTC (rev 846) @@ -1,184 +1,7 @@ -#!/usr/bin/perl +#! perl use strict; use warnings; -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use vars '$AUTOLOAD'; - -use Test::MockObject; -use Test::More tests => 41; - -my $module = 'Everything::Node::user'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::setting' ), 'user should extend setting' ); - -can_ok( $module, 'dbtables' ); -SKIP: -{ - skip( 'SUPER not appropriate yet', 1 ); - my @tables = $module->dbtables(); - is_deeply( \@tables, [qw( user document setting node )], - 'dbtables() should return node tables' ); -} - -sub AUTOLOAD -{ - return if $AUTOLOAD =~ /DESTROY$/; - - no strict 'refs'; - $AUTOLOAD =~ s/^main:://; - - my $sub = "${module}::$AUTOLOAD"; - if ( defined &{$sub} ) - { - *{$AUTOLOAD} = \&{$sub}; - goto &{$sub}; - } -} - -my $mock = Test::MockObject->new(); -my ( $method, $args, $result ); - -# $mock->fake_module( 'Everything', import => sub { $result = caller() } ); - -ok( $INC{'Everything.pm'}, '... should use Everything module' ); - -$mock->{DB} = $mock; - -# insert() -$mock->set_series( SUPER => 0, 10, 10 )->set_true('update'); - -$mock->{title} = 'foo'; - -ok( !insert( $mock, 'user' ), - 'insert() should return false if SUPER call fails' ); -is( $mock->next_call(), 'SUPER', '... and should call SUPER()' ); - -is( insert( $mock, 'user' ), - 10, '... should return inserted node_id on success' ); -( $method, $args ) = $mock->next_call(2); -is( $method, 'update', '... then calling update()' ); -is( $args->[1], 'user', '... with the user' ); -is( $mock->{author_user}, 10, '... and set "author_user" to inserted node_id' ); - -# isGod() -$mock->set_series( getNode => 0, ($mock) x 2 ) - ->set_always( inGroup => 'inGroup' ) - ->set_always( inGroupFast => 'inGroupFast' )->clear(); - -ok( !isGod($mock), - 'isGod() should return false unless it can find gods usergroup' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'getNode', '... and should call getNode() to find it' ); -is( join( '-', @$args ), "$mock-gods-usergroup", '... for gods usergroup' ); - -is( isGod($mock), 'inGroupFast', - '... should call inGroupFast() without recurse flag' ); -is( isGod( $mock, 1 ), 'inGroup', '... and inGroup() with it' ); - -# isGuest() -my @newnodes = ( - bless( { guest_user => 0 }, 'FakeNode' ), - bless( { guest_user => 1 }, 'FakeNode' ) -); -$mock->{_calls} = []; -$mock->set_series( getNode => 0, ($mock) x 2 ) - ->set_series( getVars => undef, @newnodes )->clear(); - -ok( isGuest($mock), - 'isGuest() should return true unless it can get system settings node' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'getNode', '... so it should fetch a node' ); -is( - join( '-', @$args ), - "$mock-system settings-setting", - '... the system settings' -); -ok( isGuest($mock), - '... should return true unless it can get system settings node' ); - -$mock->{node_id} = 1; - -ok( !isGuest($mock), '... should return false if node_ids do not match' ); -ok( isGuest($mock), '... and true if they do' ); - -# getNodeKeys() -my $hash_ref = { passwd => 1, lasttime => 1, title => 1 }; -$mock->set_always( SUPER => ($hash_ref) x 2 )->clear(); - -my $keys = getNodeKeys($mock); -isa_ok( $keys, 'HASH', 'getNodeKeys() should return a hash' ); -is( scalar keys %$keys, 3, '... but should delete nothing if not exporting' ); - -$keys = getNodeKeys( $mock, 1 ); -ok( !exists $keys->{passwd}, '... should delete "passwd" if exporting' ); -ok( !exists $keys->{lasttime}, '... should delete "lasttime" if exporting' ); - -# verifyFieldUpdate() - -foreach my $field (qw( title karma lasttime )) -{ - ok( !verifyFieldUpdate( $mock, $field ), - "verifyFieldUpdate should return false for '$field' field" ); -} -$mock->set_series( SUPER => 1, 0 ); -ok( - verifyFieldUpdate( $mock, 'absent' ), - '... should return false if SUPER() call does' -); -ok( !verifyFieldUpdate( $mock, 'title' ), - '... and false if field is restricted here, but not in parent' ); - -ok( !conflictsWith(), 'conflictsWith() should return false' ); - -ok( !updateFromImport(), 'updateFromImport() should return false' ); - -ok( !restrictTitle( {} ), 'restrictTitle() should return false with no title' ); -ok( - !restrictTitle( { title => 'foo|' } ), - '... or false with bad chars in title' -); -ok( - restrictTitle( { title => 'some user_name' } ), - '... or true if it has only good chars' -); - -can_ok( $module, 'getNodelets' ); -my $nodelets = { nodelets => '1,2,4' }; -$mock->set_always( getVars => $nodelets ); -is_deeply( - getNodelets($mock), - [ 1, 2, 4 ], - 'getNodelets() should return nodelets vars in array ref, if they exist' -); - -delete $nodelets->{nodelets}; -$mock->set_always( getNode => $mock )->set_series( isOfType => 1, 0 ); - -$nodelets->{nodelet_group} = $mock; -$mock->{group} = [ 4, 2, 1 ]; -is_deeply( - getNodelets($mock), - [ 4, 2, 1 ], - '... or from user nodelet group, if specified' -); - -delete $nodelets->{nodelet_group}; - -$mock->{group} = [ 8, 6, 1 ]; -$mock->clear(); - -is_deeply( - getNodelets( $mock, 'default' ), - [ 8, 6, 1 ], - '... or from default group' -); -( $method, $args ) = $mock->next_call(2); -is( $args->[1], 'default', '... so should fetch default group' ); +use Everything::Node::Test::user; +Everything::Node::Test::user->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-03 00:14:37
|
Revision: 847 Author: chromatic Date: 2006-05-02 17:14:22 -0700 (Tue, 02 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=847&view=rev Log Message: ----------- r16493@windwheel: chromatic | 2006-05-02 17:14:08 -0700 Ported the tests for the setting node to Test::Class. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/setting.pm Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/setting.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:15990 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16493 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-04-21 00:20:21 UTC (rev 846) +++ trunk/ebase/MANIFEST 2006-05-03 00:14:22 UTC (rev 847) @@ -89,6 +89,7 @@ lib/Everything/Node/workspace.pm lib/Everything/Node/Test/node.pm lib/Everything/Node/Test/nodetype.pm +lib/Everything/Node/Test/setting.pm lib/Everything/Node/Test/user.pm lib/Everything/Nodeball.pm lib/Everything/NodeBase.pm Added: trunk/ebase/lib/Everything/Node/Test/setting.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/setting.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/setting.pm 2006-05-03 00:14:22 UTC (rev 847) @@ -0,0 +1,261 @@ +package Everything::Node::Test::setting; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; + +use SUPER; +use Test::More; + +*Everything::Node::setting::SUPER = \&UNIVERSAL::SUPER; + +sub node_class { 'Everything::Node::setting' } + +sub test_extends :Test( +1 ) +{ + my $self = shift; + my $module = $self->node_class(); + ok( $module->isa( 'Everything::Node::node' ), + 'setting should extend node' ); + $self->SUPER(); +} + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $module = $self->node_class(); + + can_ok( $module, 'dbtables' ); + my @tables = $module->dbtables(); + is_deeply( \@tables, [qw( setting node )], + 'dbtables() should return node tables' ); +} + +sub test_get_vars :Test( 2 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( getHash => { foo => 'bar' } ); + + is_deeply( $node->getVars($node), { foo => 'bar' }, + 'getVars() should call getHash() on node' ); + + is( ( $node->next_call() )[1]->[1], 'vars', '... with "vars" argument' ); +} + +sub test_set_vars :Test( 2 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_true( 'setHash' ); + $node->setVars( { my => 'vars' } ); + + my ($method, $args) = $node->next_call(); + is( $method, 'setHash', 'setVars() should call setHash()' ); + is_deeply( $args->[1], { my => 'vars' }, '... with hash arguments' ); +} + +sub test_has_vars :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; + ok( $node->hasVars(), 'hasVars() should return true' ); +} + +sub test_field_to_XML :Test( +5 ) +{ + my $self = shift; + my $node = $self->{node}; + + $self->SUPER(); + + local ( *XML::DOM::Element::new, *XML::DOM::Text::new, + *Everything::Node::setting::genBasicTag, *fieldToXML ); + + my @dom; + *XML::DOM::Element::new = *XML::DOM::Text::new = sub { + push @dom, shift; + return $node; + }; + + my @tags; + *Everything::Node::setting::genBasicTag = sub { + push @tags, join( ' ', @_[ 1 .. 3 ] ); + }; + + $node->set_always( getVars => { a => 1, b => 1, c => 1 } ) + ->set_series( SUPER => 2, 10 ) + ->set_true( '-appendChild' ); + + is( $node->fieldToXML( '', 'vars' ), + $node, '... should return XML::DOM element for vars, if "vars" field' ); + is( @dom, 5, '... should make several DOM nodes:' ); + is( scalar grep( /Element/, @dom ), 1, '... one Element node' ); + is( scalar grep( /Text/, @dom ), 4, '... and several Text nodes' ); + + is( join( '!', @tags ), 'var a 1!var b 1!var c 1', + '... should call genBasicTag() on each var pair' ); +} + +sub test_xml_tag :Test( 6 ) +{ + my $self = shift; + my $node = $self->{node}; + + local *XML::DOM::TEXT_NODE; + *XML::DOM::TEXT_NODE = sub () { 1 }; + + $node->set_series( -getTagName => '', 'vars' ) + ->set_series( -getVars => ($node) x 3 ) + ->set_series( -getChildNodes => ($node) x 3 ) + ->set_series( getNodeType => 1, 0, 0 ) + ->set_true( 'setVars' ) + ->set_always( -SUPER => 'super!' ); + + my @types = ( { where => 'foo', name => 'foo' }, { name => 'bar' } ); + + my $result = $node->xmlTag( $node ); + is( $result, 'super!', + 'xmlTag() should call parent implementation unless dumping "vars"' ); + + local *Everything::Node::sett; + *Everything::Node::setting::parseBasicTag = sub { + return shift @types; + }; + + $node->{vars} = { foo => -1, bar => 1 }; + + my $fixes = $node->xmlTag( $node ); + ok( exists $node->{vars}, + '... should vivify "vars" field in node when requesting "vars"' ); + is( @$fixes, 1, '... and return array ref of fixable nodes' ); + is( $node->{vars}{ $fixes->[0]{where} }, + -1, '... and should mark fixable nodes by name in "vars"' ); + is( $node->{vars}{bar}, 1, '... and keep tag value for fixed tags' ); + my ($method, $args) = $node->next_call( 2 ); + is( join( ' ', $method, $args->[1] ), "setVars $node", + '... and should call setVars() to keep them' ); +} + +sub test_apply_xml_fix_no_fixby_node :Test( +5 ) +{ + my $self = shift; + my $node = $self->{node}; + + my $patch; + local *Everything::XML::patchXMLwhere; + *Everything::XML::patchXMLwhere = sub + { + $patch = shift; + return { type_nodetype => 'nodetype' }; + }; + + is( $node->applyXMLFix(), undef, + 'applyXMLFix() should return if called without a fix' ); + + is( $node->applyXMLFix( 'bad' ), undef, '... or with a bad fix' ); + + my $fix = {}; + for my $key (qw( fixBy field where )) + { + is( $node->applyXMLFix( $fix ), $fix, "... or without a '$key' key" ); + $fix->{$key} = ''; + } + + $self->SUPER(); +} + +sub test_apply_xml_fix :Test( +6 ) +{ + my $self = shift; + $self->SUPER(); + + my $node = $self->{node}; + my $db = $self->{mock_db}; + + my $patch; + local *Everything::XML::patchXMLwhere; + *Everything::XML::patchXMLwhere = sub + { + $patch = shift; + return { type_nodetype => 'nodetype' }; + }; + + my $fix = { map { $_ => $_ } qw( field where ) }; + $node->set_series( getVars => ( $node ) x 3 ); + $db->set_series( getNode => 0, 0, { node_id => 888 } ); + + @$fix{ 'fixBy', 'where' } = ( 'setting', 'w' ); + isa_ok( $node->applyXMLFix( $fix ), 'HASH', + '... should return setting $FIX if it cannot be found' ); + + is( $patch, 'w', + '... should call patchXMLwhere() with "where" field of FIX' ); + + $node->{title} = 'node title'; + $node->{nodetype}{title} = 'nodetype title'; + + $self->{errors} = []; + $node->applyXMLFix( + { + field => 'field', + fixBy => 'setting', + title => 'title', + type_nodetype => 'type', + where => 1, + }, + 1 + ); + + like( $self->{errors}[0][1], + qr/Unable to find 'title'.+'type'.+field/s, + '... should print error if node is not found and printError is true' ); + + $node->{node_id} = 0; + $fix->{field} = 'foo'; + + $node->set_true( 'setVars' ) + ->clear(); + + is( $node->applyXMLFix( $fix ), undef, + 'applyXMLFix() should return undef if successfully called for setting' + ); + is( $node->{foo}, 888, '... and set variable for field to node_id' ); + + my ($method, $args) = $node->next_call( 2 ); + + is( join( ' ', $method, $args->[1] ), "setVars $node", + '... and should call setVars() to save vars' + ); + +} + +sub test_get_node_keep_keys :Test( +1 ) +{ + my $self = shift; + my $node = $self->{node}; + my $result = $node->getNodeKeepKeys(); + is( $result->{vars}, 1, '... and should set "vars" to true in results' ); + $self->SUPER(); +} + +sub test_update_from_import :Test( 3 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( -SUPER => 10 ) + ->set_series( -getVars => { a => 1, b => 2 }, $node ) + ->set_true( 'setVars' ); + + is( $node->updateFromImport( $node ), 10, + 'updateFromImport() should call SUPER()' ); + is( $node->next_call(), 'setVars', '... and should call setVars()' ); + is( join( '', @$node{ 'a', 'b' } ), '12', + '... and merging keys from new node' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/setting.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/setting.pm =================================================================== --- trunk/ebase/lib/Everything/Node/setting.pm 2006-04-21 00:20:21 UTC (rev 846) +++ trunk/ebase/lib/Everything/Node/setting.pm 2006-05-03 00:14:22 UTC (rev 847) @@ -210,7 +210,7 @@ { my ($this) = @_; - my $nodekeys = $this->SUPER(); + my $nodekeys = $this->SUPER(); $nodekeys->{vars} = 1; return $nodekeys; @@ -221,13 +221,13 @@ { my ( $this, $NEWNODE, $USER ) = @_; - my $V = $this->getVars; - my $NEWV = $NEWNODE->getVars; + my $V = $this->getVars(); + my $NEWV = $NEWNODE->getVars(); @$NEWV{ keys %$V } = values %$V; $this->setVars($NEWV); - $this->SUPER(); + $this->SUPER( $NEWNODE, $USER ); } 1; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-03 19:30:46
|
Revision: 848 Author: chromatic Date: 2006-05-03 12:30:33 -0700 (Wed, 03 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=848&view=rev Log Message: ----------- r16495@windwheel: chromatic | 2006-05-03 12:30:13 -0700 Ported dbtable tests to Test::Class. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/Test/node.pm trunk/ebase/lib/Everything/Node/dbtable.pm trunk/ebase/t/Node/dbtable.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/dbtable.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16493 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16495 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-03 00:14:22 UTC (rev 847) +++ trunk/ebase/MANIFEST 2006-05-03 19:30:33 UTC (rev 848) @@ -87,6 +87,7 @@ lib/Everything/Node/user.pm lib/Everything/Node/usergroup.pm lib/Everything/Node/workspace.pm +lib/Everything/Node/Test/dbtable.pm lib/Everything/Node/Test/node.pm lib/Everything/Node/Test/nodetype.pm lib/Everything/Node/Test/setting.pm Added: trunk/ebase/lib/Everything/Node/Test/dbtable.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/dbtable.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/dbtable.pm 2006-05-03 19:30:33 UTC (rev 848) @@ -0,0 +1,124 @@ +package Everything::Node::Test::dbtable; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; + +use SUPER; +use Test::More; + +*Everything::Node::dbtable::SUPER = \&UNIVERSAL::SUPER; + +sub node_class { 'Everything::Node::dbtable' }; + +sub test_insert :Test( 8 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->{title} = 'foo'; + $node->set_series( SUPER => -1, 0, 1 ); + $db->set_true( 'createNodeTable' ); + + my $result = $node->insert( 'user' ); + my ($method, $args) = $node->next_call(); + + isnt( $db->next_call(), 'createNodeTable', + 'insert() should not create node table unless SUPER() succeeds' ); + is( $result, -1, '... and should return result of SUPER() call' ); + is( $method, 'SUPER', '... so should call SUPER()' ); + is( $args->[1], 'user', '... passing user argument' ); + + $result = $node->insert(); + isnt( $db->next_call(), 'createNodeTable', + '... nor should it create table if SUPER() returns false' ); + + $result = $node->insert(); + is( $result, 1, '... but should return node_id if insert succeeds' ); + + ($method, $args) = $db->next_call(); + is( $method, 'createNodeTable', '... creating table' ); + is( $args->[1], 'foo', '... named after the node' ); +} + +sub test_insert_access :Test( +0 ) +{ + my $self = shift; + my $db = $self->{mock_db}; + $db->set_true( -createNodeTable ); + $self->SUPER(); +} + +sub test_insert_restrict_dupes :Test( +0 ) +{ + my $self = shift; + my $db = $self->{mock_db}; + $db->set_true( -createNodeTable ); + $self->SUPER(); +} + +sub test_insert_restrictions :Test( +0 ) +{ + my $self = shift; + my $db = $self->{mock_db}; + $db->set_true( -createNodeTable ); + $self->SUPER(); +} + +sub test_nuke :Test( 8 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->{title} = 'foo'; + $node->set_series( SUPER => -1, 0, 1 ); + $db->set_true( 'dropNodeTable' ); + + my $result = $node->nuke( 'user' ); + my ($method, $args) = $node->next_call(); + + isnt( $db->next_call(), 'dropNodeTable', + 'nuke() should not drop node table unless SUPER() succeeds' ); + is( $result, -1, '... and should return result of SUPER() call' ); + is( $method, 'SUPER', '... so should call SUPER()' ); + is( $args->[1], 'user', '... passing user argument' ); + + $result = $node->nuke(); + isnt( $db->next_call(), 'dropNodeTable', + '... nor should it drop table if SUPER() returns false' ); + + $result = $node->nuke(); + is( $result, 1, '... but should return node_id if nuke succeeds' ); + + ($method, $args) = $db->next_call(); + is( $method, 'dropNodeTable', '... dropping table' ); + is( $args->[1], 'foo', '... named after the node' ); +} + +sub test_restrict_title :Test( 8 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->{title} = 'longblob'; + ok( ! $node->restrictTitle(), + 'restrictTitle() should return false if title is a db reserved word' ); + like( $self->{errors}[0][0], qr/reserved word/, '.. and should log error' ); + + $node->{title} = 'x' x 62; + ok( ! $node->restrictTitle(), '... or if title exceeds 61 characters' ); + + like( $self->{errors}[1][0], qr/exceed 61/, '.. and should log error' ); + + $node->{title} = 'a b'; + ok( ! $node->restrictTitle(), + '... should fail if title contains non-word characters' ); + + like( $self->{errors}[2][0], qr/invalid characters/, + '.. and should log error' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/dbtable.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-05-03 00:14:22 UTC (rev 847) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-05-03 19:30:33 UTC (rev 848) @@ -137,7 +137,7 @@ $db->set_series( -sqlSelect => 1, 0 ) ->set_always( -getFields => 'none' ) ->set_always( -now => '' ) - ->set_always( -getNode => undef ) + ->set_series( -getNode => undef, { DB => $db } ) ->set_true( 'sqlInsert' ) ->set_always( -lastValue => 100 ); Modified: trunk/ebase/lib/Everything/Node/dbtable.pm =================================================================== --- trunk/ebase/lib/Everything/Node/dbtable.pm 2006-05-03 00:14:22 UTC (rev 847) +++ trunk/ebase/lib/Everything/Node/dbtable.pm 2006-05-03 19:30:33 UTC (rev 848) @@ -27,7 +27,7 @@ { my ( $this, $USER ) = @_; - my $result = $this->SUPER(); + my $result = $this->SUPER( $USER ); $this->{DB}->createNodeTable( $this->{title} ) if $result > 0; @@ -119,7 +119,7 @@ sub nuke { my ( $this, $USER ) = @_; - my $result = $this->SUPER(); + my $result = $this->SUPER( $USER ); $this->{DB}->dropNodeTable( $this->{title} ) if $result > 0; Modified: trunk/ebase/t/Node/dbtable.t =================================================================== --- trunk/ebase/t/Node/dbtable.t 2006-05-03 00:14:22 UTC (rev 847) +++ trunk/ebase/t/Node/dbtable.t 2006-05-03 19:30:33 UTC (rev 848) @@ -1,108 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use vars qw( $errors $AUTOLOAD ); - -use FakeNode; -use Test::More tests => 19; - -my $module = 'Everything::Node::dbtable'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::node' ), 'dbtable should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [ 'node' ], 'dbtables() should return node tables' ); - -local *Everything::logErrors; - -*Everything::logErrors = sub -{ - $main::errors = shift; -}; - -my $node = FakeNode->new(); - -# insert() -$node->{title} = 'foo'; -$node->{_subs} = { - SUPER => [ -1, 0, 1 ], - restrictTitle => [ 0, (1) x 4 ], -}; -$node->{DB} = $node; - -$node->{title} = 'afin3tit1e'; - -$node->{_calls} = []; -is( insert($node), -1, '... should return result of SUPER() call' ); -is( join( ' ', @{ $node->{_calls}[0] } ), - 'SUPER', '... and should not call createNodeTable() if SUPER() fails' ); - -$node->{_calls} = []; -insert($node); -is( scalar @{ $node->{_calls} }, - 1, '... or if SUPER() returns an invalid node_id' ); -is( insert($node), 1, '... should return node_id if insert() succeeds' ); -is( - join( ' ', @{ pop @{ $node->{_calls} } } ), - 'createNodeTable afin3tit1e', - '... and should call createNodeTable() if it succeeds' -); - -# nuke() -$node->{_subs}{SUPER} = [ -1, 0, 1 ]; -is( nuke($node), -1, 'nuke() should return result of SUPER() call' ); -is( join( ' ', @{ pop @{ $node->{_calls} } } ), - 'SUPER', '... and should not call dropNodeTable() if SUPER() fails' ); - -nuke($node); -is( join( ' ', @{ pop @{ $node->{_calls} } } ), - 'SUPER', '... or if SUPER() returns an invalid node_id' ); -nuke($node); -is( - join( ' ', @{ pop @{ $node->{_calls} } } ), - 'dropNodeTable afin3tit1e', - '... but should call dropNodeTable() if it succeeds' -); - -# restrictTitle() -ok( !restrictTitle( { foo => 1 } ), - 'restrictTitle() with no title field should return false' ); -ok( - !restrictTitle( { title => 'longblob' } ), - '... or if title is a db reserved word' -); - -ok( - !restrictTitle( { title => 'x' x 62 } ), - '... or if title exceeds 61 characters' -); -like( $errors, qr/exceed 61/, '.. and should log error' ); - -ok( !restrictTitle( { title => 'a b' } ), - '... should fail if title contains non-word characters' ); -like( $errors, qr/invalid characters/, '.. and should log error' ); - -sub AUTOLOAD -{ - return if $AUTOLOAD =~ /DESTROY$/; - - no strict 'refs'; - $AUTOLOAD =~ s/^main:://; - - my $sub = "Everything::Node::dbtable::$AUTOLOAD"; - if ( defined &{$sub} ) - { - *{$AUTOLOAD} = \&{$sub}; - goto &{$sub}; - } -} +use Everything::Node::Test::dbtable; +Everything::Node::Test::dbtable->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-03 19:48:28
|
Revision: 849 Author: chromatic Date: 2006-05-03 12:48:22 -0700 (Wed, 03 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=849&view=rev Log Message: ----------- r16497@windwheel: chromatic | 2006-05-03 12:48:03 -0700 Use the (new) setting node tests, as they're more useful and accurate. Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/user.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16495 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16497 Modified: trunk/ebase/lib/Everything/Node/Test/user.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/user.pm 2006-05-03 19:30:33 UTC (rev 848) +++ trunk/ebase/lib/Everything/Node/Test/user.pm 2006-05-03 19:48:22 UTC (rev 849) @@ -10,7 +10,7 @@ *Everything::Node::user::SUPER = \&UNIVERSAL::SUPER; -use base 'Everything::Node::Test::node'; +use base 'Everything::Node::Test::setting'; sub node_class { 'Everything::Node::user' } @@ -212,15 +212,4 @@ '... or from default group' ); } -# XXX - delete me soon -sub test_has_vars :Test( 1 ) -{ - my $self = shift; - my $node = $self->{node}; - ok( $node->hasVars(), 'user node should have vars' ); -} - -# XXX - delete soon -sub test_xml_tag :Test(+0) {} - 1; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-03 19:49:49
|
Revision: 850 Author: chromatic Date: 2006-05-03 12:49:41 -0700 (Wed, 03 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=850&view=rev Log Message: ----------- r16499@windwheel: chromatic | 2006-05-03 12:49:22 -0700 Fixed incorrect test count. Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/dbtable.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16497 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16499 Modified: trunk/ebase/lib/Everything/Node/Test/dbtable.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/dbtable.pm 2006-05-03 19:48:22 UTC (rev 849) +++ trunk/ebase/lib/Everything/Node/Test/dbtable.pm 2006-05-03 19:49:41 UTC (rev 850) @@ -98,7 +98,7 @@ is( $args->[1], 'foo', '... named after the node' ); } -sub test_restrict_title :Test( 8 ) +sub test_restrict_title :Test( 6 ) { my $self = shift; my $node = $self->{node}; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-03 19:51:20
|
Revision: 851 Author: chromatic Date: 2006-05-03 12:51:05 -0700 (Wed, 03 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=851&view=rev Log Message: ----------- r16501@windwheel: chromatic | 2006-05-03 12:50:46 -0700 Ported tests for htmlcode nodes to Test::Class. Made restrictTitle() test a little less strict in node tests. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/Test/node.pm trunk/ebase/t/Node/htmlcode.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/htmlcode.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16499 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16501 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-03 19:49:41 UTC (rev 850) +++ trunk/ebase/MANIFEST 2006-05-03 19:51:05 UTC (rev 851) @@ -88,6 +88,7 @@ lib/Everything/Node/usergroup.pm lib/Everything/Node/workspace.pm lib/Everything/Node/Test/dbtable.pm +lib/Everything/Node/Test/htmlcode.pm lib/Everything/Node/Test/node.pm lib/Everything/Node/Test/nodetype.pm lib/Everything/Node/Test/setting.pm Added: trunk/ebase/lib/Everything/Node/Test/htmlcode.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/htmlcode.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/htmlcode.pm 2006-05-03 19:51:05 UTC (rev 851) @@ -0,0 +1,45 @@ +package Everything::Node::Test::htmlcode; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; + +use Test::More; +use SUPER; + +*Everything::Node::htmlcode::SUPER = \&UNIVERSAL::SUPER; + +sub node_class { 'Everything::Node::htmlcode' } + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $class = $self->node_class(); + can_ok( $class, 'dbtables' ); + my @tables = $class->dbtables(); + is_deeply( \@tables, [qw( htmlcode node )], + 'dbtables() should return node tables' ); +} + +1; + +sub test_restrict_title :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + + ok( ! $node->restrictTitle(), + 'restrictTitle() should return false with no title' ); + + $node->{title} = 'bad title'; + ok( ! $node->restrictTitle(), + '... should return false if title contains a space' ); + + like( $self->{errors}[0][0], qr/htmlcode.+invalid characters/, + '... logging an error' ); + + $node->{title} = join( '', ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9 ) ); + ok( $node->restrictTitle(), + '... returning true if title contains only alphanumeric characters' ); +} Property changes on: trunk/ebase/lib/Everything/Node/Test/htmlcode.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-05-03 19:49:41 UTC (rev 850) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-05-03 19:51:05 UTC (rev 851) @@ -344,7 +344,7 @@ $node->{title} = 'o|o'; ok( ! $node->restrictTitle(), '... or a pipe' ); - like( $self->{errors}[0][0], qr/node.+invalid characters/, + like( $self->{errors}[0][0], qr/name.+invalid characters/, '... and should log error' ); $node->{title} = 'a good name zz9'; Modified: trunk/ebase/t/Node/htmlcode.t =================================================================== --- trunk/ebase/t/Node/htmlcode.t 2006-05-03 19:49:41 UTC (rev 850) +++ trunk/ebase/t/Node/htmlcode.t 2006-05-03 19:51:05 UTC (rev 851) @@ -1,62 +1,7 @@ -#!/usr/bin/perl +#! perl use strict; use warnings; -use vars qw( $AUTOLOAD $errors ); - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 8; - -my $module = 'Everything::Node::htmlcode'; -use_ok( $module ) or exit; -ok( $module->isa( 'Everything::Node::node' ), 'htmlcode should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( htmlcode node )], - 'dbtables() should return node tables' ); - -local *Everything::logErrors; -*Everything::logErrors = sub -{ - $main::errors = join( ' ', @_ ); -}; - -# restrictTitle() -ok( !restrictTitle( {} ), 'restrictTitle() should return false with no title' ); -{ - ok( - !restrictTitle( { title => 'bad title' } ), - '... should return false if title contains a space' - ); - like( $errors, qr/htmlcode.+invalid characters/, '... logging an error' ); - -} -ok( - restrictTitle( - { title => join( '', ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9 ) ) } - ), - '... should return true if title contains only alphanumeric characters' -); - -sub AUTOLOAD -{ - return if $AUTOLOAD =~ /DESTROY$/; - - no strict 'refs'; - $AUTOLOAD =~ s/^main:://; - - my $sub = "Everything::Node::htmlcode::$AUTOLOAD"; - - if ( defined &{$sub} ) - { - *{$AUTOLOAD} = \&{$sub}; - goto &{$sub}; - } -} +use Everything::Node::Test::htmlcode; +Everything::Node::Test::htmlcode->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-04 20:16:36
|
Revision: 852 Author: chromatic Date: 2006-05-04 13:16:19 -0700 (Thu, 04 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=852&view=rev Log Message: ----------- r16503@windwheel: chromatic | 2006-05-04 13:16:07 -0700 Autodetect node class to test in Everything::Node::Test::node::node_class(). Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/dbtable.pm trunk/ebase/lib/Everything/Node/Test/htmlcode.pm trunk/ebase/lib/Everything/Node/Test/node.pm trunk/ebase/lib/Everything/Node/Test/nodetype.pm trunk/ebase/lib/Everything/Node/Test/setting.pm trunk/ebase/lib/Everything/Node/Test/user.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16501 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16503 Modified: trunk/ebase/lib/Everything/Node/Test/dbtable.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/dbtable.pm 2006-05-03 19:51:05 UTC (rev 851) +++ trunk/ebase/lib/Everything/Node/Test/dbtable.pm 2006-05-04 20:16:19 UTC (rev 852) @@ -10,8 +10,6 @@ *Everything::Node::dbtable::SUPER = \&UNIVERSAL::SUPER; -sub node_class { 'Everything::Node::dbtable' }; - sub test_insert :Test( 8 ) { my $self = shift; Modified: trunk/ebase/lib/Everything/Node/Test/htmlcode.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/htmlcode.pm 2006-05-03 19:51:05 UTC (rev 851) +++ trunk/ebase/lib/Everything/Node/Test/htmlcode.pm 2006-05-04 20:16:19 UTC (rev 852) @@ -10,8 +10,6 @@ *Everything::Node::htmlcode::SUPER = \&UNIVERSAL::SUPER; -sub node_class { 'Everything::Node::htmlcode' } - sub test_dbtables :Test( 2 ) { my $self = shift; Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-05-03 19:51:05 UTC (rev 851) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-05-04 20:16:19 UTC (rev 852) @@ -9,11 +9,18 @@ use Test::MockObject; use Test::MockObject::Extends; -use Scalar::Util 'reftype'; +use Scalar::Util qw( reftype blessed ); local *Everything::Node::SUPER = \&UNIVERSAL::SUPER; -sub node_class { 'Everything::Node::node' } +sub node_class +{ + my $self = shift; + my $name = blessed( $self ); + $name =~ s/Test:://; + return $name; +} + sub startup :Test( startup => 3 ) { my $self = shift; Modified: trunk/ebase/lib/Everything/Node/Test/nodetype.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/nodetype.pm 2006-05-03 19:51:05 UTC (rev 851) +++ trunk/ebase/lib/Everything/Node/Test/nodetype.pm 2006-05-04 20:16:19 UTC (rev 852) @@ -10,8 +10,6 @@ # XXX - hack for now *Everything::Node::nodetype::SUPER = \&UNIVERSAL::SUPER; -sub node_class { 'Everything::Node::nodetype' } - sub startup :Test( +1 ) { my $self = shift; Modified: trunk/ebase/lib/Everything/Node/Test/setting.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/setting.pm 2006-05-03 19:51:05 UTC (rev 851) +++ trunk/ebase/lib/Everything/Node/Test/setting.pm 2006-05-04 20:16:19 UTC (rev 852) @@ -10,8 +10,6 @@ *Everything::Node::setting::SUPER = \&UNIVERSAL::SUPER; -sub node_class { 'Everything::Node::setting' } - sub test_extends :Test( +1 ) { my $self = shift; Modified: trunk/ebase/lib/Everything/Node/Test/user.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/user.pm 2006-05-03 19:51:05 UTC (rev 851) +++ trunk/ebase/lib/Everything/Node/Test/user.pm 2006-05-04 20:16:19 UTC (rev 852) @@ -12,8 +12,6 @@ use base 'Everything::Node::Test::setting'; -sub node_class { 'Everything::Node::user' } - sub test_extends :Test( +1 ) { my $self = shift; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-04 21:39:59
|
Revision: 853 Author: chromatic Date: 2006-05-04 14:39:25 -0700 (Thu, 04 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=853&view=rev Log Message: ----------- r16505@windwheel: chromatic | 2006-05-04 14:39:10 -0700 Started porting nodegroup tests to the new form. Fixed a couple of bugs and nits in nodegroup while I had the chance. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/Test/node.pm trunk/ebase/lib/Everything/Node/nodegroup.pm trunk/ebase/t/Node/nodegroup.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/nodegroup.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16503 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16505 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-04 20:16:19 UTC (rev 852) +++ trunk/ebase/MANIFEST 2006-05-04 21:39:25 UTC (rev 853) @@ -90,6 +90,7 @@ lib/Everything/Node/Test/dbtable.pm lib/Everything/Node/Test/htmlcode.pm lib/Everything/Node/Test/node.pm +lib/Everything/Node/Test/nodegroup.pm lib/Everything/Node/Test/nodetype.pm lib/Everything/Node/Test/setting.pm lib/Everything/Node/Test/user.pm Modified: trunk/ebase/lib/Everything/Node/Test/node.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/node.pm 2006-05-04 20:16:19 UTC (rev 852) +++ trunk/ebase/lib/Everything/Node/Test/node.pm 2006-05-04 21:39:25 UTC (rev 853) @@ -482,9 +482,9 @@ $node->updateFromImport( { foo => 1, bar => 2, baz => 3 }, 'user' ); is( $node->{foo} + $node->{baz}, 4, - 'getNodeKeys() should merge node keys' ); + 'updateFromImport() should merge node keys' ); + ok( ! exists $node->{bar}, '... but not those it should keep' ); - ok( ! exists $node->{bar}, '... but not those it should keep' ); my ( $method, $args ) = $node->next_call(); is( "$method @$args", "update $node user nomodify", '... and should update node' ); Added: trunk/ebase/lib/Everything/Node/Test/nodegroup.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/nodegroup.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/nodegroup.pm 2006-05-04 21:39:25 UTC (rev 853) @@ -0,0 +1,675 @@ +package Everything::Node::Test::nodegroup; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; + +use SUPER; +use Test::More; + +*Everything::Node::nodegroup::SUPER = \&UNIVERSAL::SUPER; + +sub test_construct :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( selectGroupArray => 'group' ); + + $node->construct(); + is( $node->{group}, 'group', + 'construct() should set "group" field to group array' ); +} + +sub test_select_group_array :Test( 8 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->{node_id} = 111; + $node->set_always( isGroup => 'grouptable' ); + $db->set_true( qw( createGroupTable finish )) + ->set_series( sqlSelectMany => undef, $db ) + ->set_series( fetchrow => ( 1, 7, 9 ) ); + + my $result = $node->selectGroupArray(); + my ( $method, $args ) = $node->next_call(); + is( $method, 'isGroup', + 'selectGroupArray() should call isGroup() to get group table' ); + is( $result, undef, '... returning if selection fails' ); + + $result = $node->selectGroupArray(); + + isa_ok( $result, 'ARRAY', + '... and should return contained nodes in something that' ); + is( @$result, 3, '... ALL of the nodes' ); + + ( $method, $args ) = $db->next_call(); + is( $method, 'createGroupTable', '... ensuring that the table exists' ); + is( $args->[1], 'grouptable', '... with the correct name' ); + + ( $method, $args ) = $db->next_call(); + is( $method, 'sqlSelectMany', + '... and should select nodes from the group table' ); + is( join( '-', @$args ), + "$db-node_id-grouptable-grouptable_id=111-ORDER BY orderby", + '... with the appropriate arguments' ); +} + +sub test_destruct :Test( +2 ) +{ + my $self = shift; + my $node = $self->{node}; + + $self->SUPER(); + + $node->{group} = $node->{flatgroup} = 1; + $node->destruct(); + + ok( ! exists $node->{group}, '... should delete the "group" variable' ); + ok( ! exists $node->{flatgroup}, '... and the "flatgroup" variable' ); +} + +sub test_insert :Test( +4 ) +{ + my $self = shift; + my $node = $self->{node}; + $node->set_true( 'updateGroup' ) + ->set_always( -SUPER => 101 ); + + $node->{group} = 'foo'; + + is( $node->insert( 'user2' ), 101, + 'insert() should return node_id if check succeeds' ); + is( $node->{group}, 'foo', + '... retaining group attribute' ); + + my ( $method, $args ) = $node->next_call(); + is( $method, 'updateGroup', '... calling updateGroup()' ); + is( $args->[1], 'user2', '... with user' ); + + $node->unmock( 'SUPER' ) + ->set_true( -updateGroup ); + $self->SUPER(); +} + +sub test_update :Test( +3 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( -SUPER => 4 ) + ->set_true( 'updateGroup' ); + + is( $node->update( 8 ), 4, + 'update() should return results of SUPER() call' ); + + my ( $method, $args ) = $node->next_call(); + is( $method, 'updateGroup', '... updating the group' ); + is( $args->[1], 8, '... with the provided user' ); + + $node->unmock( 'SUPER' ) + ->set_true( -updateGroup ); + + $self->SUPER(); +} + +sub test_update_from_import :Test( +4 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( -SUPER => 6 ) + ->set_true( 'updateGroup' ); + + is( $node->updateFromImport( { group => 7 }, 'user' ), 6, + 'updateFromImport() should return result of SUPER() call' ); + + is( $node->{group}, 7, '... seting group to new group' ); + + my ($method, $args) = $node->next_call(); + is( $method, 'updateGroup', '... and updating group' ); + is( $args->[1], 'user', '... with the user' ); + + $node->unmock( 'SUPER' ) + ->set_true( -updateGroup ); + $self->SUPER(); +} + +sub test_update_group_access :Test( 2 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( hasAccess => 0 ); + + ok( ! $node->updateGroup(), + 'updateGroup() should return false without user' ); + ok( ! $node->updateGroup( 'user' ), + '... or if user has no write access' ); +} + +sub test_update_group :Test( 19 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->set_always( isGroup => 'gtable' ) + ->set_true( 'hasAccess' ) + ->mock( restrict_type => sub { $_[1] } ) + ->set_series( selectGroupArray => ( [ 2, 4, 6, 10 ] ) ); + + $db->set_true( qw( sqlSelect sqlInsert sqlUpdate -groupUncache )) + ->set_series( -sqlDelete => ( 1, 2, 1, 2 ) ); + + $node->{node_id} = 411; + $node->{group} = [ 1, 2, 4, 8 ]; + + ok( $node->updateGroup( 'user' ), + 'updateGroup() should succeed if user has access' ); + + my ( $method, $args ) = $node->next_call(2); + is( $method, 'restrict_type', '... should restrict group members' ); + is_deeply( $args->[1], [ 1, 2, 4, 8 ], '... to group' ); + is( $node->next_call(), 'isGroup', '... fetching group table' ); + is( $node->next_call(), 'selectGroupArray', '... and group node_ids' ); + + my %group; + @group{ @{ $node->{group} } } = (); + ok( !( exists $group{6} and exists $group{10} ), + '... deleting nodes that do not exist in new group' ); + is( join( '-', sort keys %group ), '1-2-4-8', + '... keeping the correct nodes' ); + like( $self->{errors}[0][0], qr/Wrong number of group members deleted!/, + '... warning if deleting the wrong number of nodes' ); + + ( $method, $args ) = $db->next_call(); + + is( $method, 'sqlSelect', '... selecting max rank if inserting' ); + like( join( '-', @$args ), qr/max\(rank\)-gtable-gtable_id=/, + '... from proper table' ); + + ( $method, $args ) = $db->next_call(); + is( $method, 'sqlInsert', '... inserting new nodes' ); + is( $args->[1], 'gtable', '... into the right table' ); + is( $args->[2]{gtable_id}, 411, '... for the right group' ); + is( $args->[2]{node_id}, 8, '... and the right node_id' ); + + ( $method, $args ) = $db->next_call( 13 ); + is( $method, 'sqlUpdate', '... updating each node in group' ); + is( $args->[1], 'gtable', '... in the group table' ); + is( $args->[2]{orderby}, 3, '...with new order' ); + like( $args->[3], qr/gtable_id=411.+node_id=8.+rank/, + '... with the correct arguments' ); + is( join( ' ', @{ $node->{group} } ), '1 2 4 8', + '... assigning new group to the node' ); +} + +1; +__END__ + + # nuke() + $node->{node_id} = 7; + $node->{dbh} = $node; + + $node->set_always( SUPER => 12 )->set_always( isGroup => 'table' ) + ->set_series( hasAccess => ( 1, 0 ) )->set_true('getRef')->clear(); + + is( nuke( $node, 'user' ), 12, 'nuke() should return result of SUPER() call' ); + is( $node->next_call(), 'isGroup', '... should fetch group table' ); + is( $node->next_call(), 'getRef', '... should nodify user parameter' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'hasAccess', '... should check for access' ); + is( join( '-', @$args ), "$node-user-d", '... user delete access' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'sqlDelete', '... and should delete the node' ); + is( join( '-', @$args ), "$node-table-table_id=7", '... with the proper id' ); + + is( $node->next_call(), 'SUPER', '... calling SUPER' ); + ok( !nuke( $node, '' ), '... returning false if user cannot nuke this node' ); + + # isGroup() + $node->{type}{derived_grouptable} = 77; + is( isGroup($node), 77, 'isGroup() should return derived group table' ); + + # inGroupFast() + $node->{group} = [ 1, 3, 5, 7, 17, 43 ]; + $node->set_series( getId => 17, 44 )->set_true('groupCache') + ->set_always( 'existsInGroupCache', 'cached?' )->clear(); + + $result = inGroupFast( $node, 'node!' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'getId', 'inGroupFast() should find node_id' ); + is( $args->[1], 'node!', '... of node' ); + is( $node->next_call(), 'groupCache', '... populating cache' ); + is( $result, 'cached?', '... returning result of cache lookup' ); + + # inGroup() + ok( !inGroup($node), 'inGroup() should return false if no node is provided' ); + + $node->set_always( selectNodegroupFlat => 'flat' ) + ->set_always( getId => 'node_id' )->set_series( hasGroupCache => ( 0, 1 ) ) + ->set_always( existsInGroupCache => 'cached?' )->clear(); + + $result = inGroup( $node, 'foo' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'getId', '... should make sure it has a node_id' ); + is( $args->[1], 'foo', '... with the node parameter' ); + + ( $method, $args ) = $node->next_call(); + is( $method, 'hasGroupCache', "... checking if there's a group cache" ); + + ( $method, $args ) = $node->next_call(); + is( $method, 'selectNodegroupFlat', + '... should call selectNodegroupFlat() to get all group members (if not)' ); + + ( $method, $args ) = $node->next_call(); + is( $method, 'groupCache', '... caching results' ); + is( $args->[1], 'flat', '... with flat nodegroup' ); + + ( $method, $args ) = $node->next_call(); + is( $method, 'existsInGroupCache', '... checking group cache' ); + is( $args->[1], 'node_id', '... with node_id' ); + is( $result, 'cached?', '... returning result' ); + + $node->clear(); + inGroup( $node, 'bar' ); + is( $node->next_call(3), 'existsInGroupCache', + '... not rebuilding cache if it exists' ); + ok( !inGroup(), '.... returning false if no node is provided' ); + + # selectNodegroupFlat() + $node->{flatgroup} = 17; + is( selectNodegroupFlat($node), + 17, 'selectNodegroupFlat() should return cached group, if it exists' ); + delete $node->{flatgroup}; + + my $traversed = { $node->{node_id} => 1, }; + is( selectNodegroupFlat( $node, $traversed ), + undef, '... or false if it has seen this node before' ); + + $traversed = {}; + $node->set_series( getNode => ( $node, undef, $node ) ) + ->set_series( isGroup => ( 1, 0 ) ) + ->set_always( selectNodegroupFlat => [ 4, 5 ] )->clear(); + + $node->{group} = [ 1, 2 ]; + + $result = selectNodegroupFlat( $node, $traversed ); + ok( + exists $traversed->{ $node->{node_id} }, + '... should mark this node as seen' + ); + + ( $method, $args ) = $node->next_call(); + is( $method, 'getNode', '... should fetch each node in group' ); + is( $args->[1], 1, '... by node_id' ); + is( $node->next_call(), 'isGroup', '... checking if node is a group node' ); + + ( $method, $args ) = $node->next_call(); + is( $method, 'selectNodegroupFlat', '... fetching group nodes' ); + is( $args->[1], $traversed, '... passing traversed hash' ); + is( join( ' ', @$result ), '4 5', '... returning list of contained nodes' ); + is( $node->{flatgroup}, $result, '... and should cache group' ); + + # insertIntoGroup() + ok( !insertIntoGroup($node), + 'insertIntoGroup() should return false unless a user is provided' ); + ok( !insertIntoGroup( $node, 1 ), '... or if no insertables are provided' ); + + $node->set_series( hasAccess => ( 0, 1, 1 ) ); + ok( + !insertIntoGroup( $node, 'user', 1 ), + '... or if user does not have write access' + ); + + ( $method, $args ) = $node->next_call(2); + is( $method, 'hasAccess', '... so it should check access' ); + is( join( '-', @$args ), "$node-user-w", '... write access for user' ); + + $node->set_series( restrict_type => ( [ 1 .. 3 ], [4] ) ) + ->set_series( getId => 3, 2, 1, 4 )->clear(); + + insertIntoGroup( $node, 'user', 1, 1 ); + ( $method, $args ) = $node->next_call(2); + + is( $method, 'restrict_type', '... checking for type restriction on group' ); + isa_ok( $args->[1], 'ARRAY', + '... allowing an insertion refs that is scalar or' ); + + my $count; + while ( $method = $node->next_call() ) + { + $count++ if $method eq 'getId'; + } + + is( $count, 3, '... should get node id of insertion' ); + is( join( ' ', @{ $node->{group} } ), + '1 3 2 1 2', '... should update "group" field' ); + ok( !exists $node->{flatgroup}, '... and delete "flatgroup" field' ); + ok( insertIntoGroup( $node, 'user', 1 ), '... should return true on success' ); + is( join( ' ', @{ $node->{group} } ), + '1 3 2 1 2 4', '... appending new nodes if no position is given' ); + + # removeFromGroup() + ok( !removeFromGroup($node), + 'removeFromGroup() should return false unless a user is provided' ); + ok( !removeFromGroup( $node, 'user' ), + '... or if no insertables are provided' ); + + $node->set_series( hasAccess => ( 0, 1 ) )->clear(); + + ok( + !removeFromGroup( $node, 6, 'user' ), + '... or if user does not have write access' + ); + ( $method, $args ) = $node->next_call(); + is( $method, 'hasAccess', '... checking for access' ); + is( join( '-', @$args ), "$node-user-w", '... write access for user' ); + + $node->set_always( hasAccess => (1) )->set_always( getId => (6) )->clear(); + + $node->{_calls} = []; + $node->{group} = [ 3, 6, 9, 12 ]; + + $result = removeFromGroup( $node, 6, 'user' ); + ( $method, $args ) = $node->next_call(2); + is( $method, 'getId', '... should get node_id' ); + is( $args->[1], 6, '... of removable node' ); + + is( join( ' ', @{ $node->{group} } ), + '3 9 12', '... should assign new "group" field without removed node' ); + ok( $result, '... should return true on success' ); + ok( !exists $node->{flatgroup}, '... deleting the cached flat group' ); + is( $node->next_call(), 'groupUncache', '... and uncaching group' ); + + # replaceGroup() + $node->set_series( isGroup => ( '', 'table' ) )->set_series( hasAccess => 0, 1 ) + ->set_always( restrict_type => 'abc' )->clear(); + + $result = replaceGroup( $node, 'replace', 'user' ); + + is( $node->next_call(), 'isGroup', 'replaceGroup() should fetch group table' ); + ok( !$result, '... should return false if user does not have write access' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'hasAccess', '... checking for access' ); + is( join( '-', @$args ), "$node-user-w", '... write access for user' ); + + $node->{group} = $node->{flatgroup} = 123; + $result = replaceGroup( $node, 'replace', 'user' ); + + ( $method, $args ) = $node->next_call(3); + is( $method, 'restrict_type', '... restricting types of new group' ); + isa_ok( $args->[1], 'ARRAY', '... constraining argument to something that ' ); + is( $node->{group}, 'abc', + '... should replace existing "group" field with new group' ); + ok( !exists $node->{flatgroup}, '... and should delete any "flatgroup" field' ); + is( $node->next_call(), 'groupUncache', '... uncaching group' ); + ok( $result, '... should return true on success' ); + + # getNodeKeys() + $node->set_series( SUPER => { foo => 1 }, { foo => 2 } )->clear(); + + $result = getNodeKeys( $node, 1 ); + is( $node->next_call(), 'SUPER', + 'getNodeKeys() should call SUPER() to get parent type keys' ); + isa_ok( $result, 'HASH', '... should return a hash reference of keys' ); + ok( exists $result->{group}, + '... including a group key if the forExport flag is set' ); + ok( !exists getNodeKeys($node)->{group}, '... excluding it otherwise' ); + + # fieldToXML() + $node->set_series( SUPER => ( 5, 6, 7 ) )->set_true('appendChild')->clear(); + + $result = fieldToXML( $node, '', '' ); + is( $node->next_call(), 'SUPER', + 'fieldToXML() should just call SUPER() if not handling a group field' ); + + is( $result, 5, '... returning the results' ); + { + local ( *XML::DOM::Element::new, *XML::DOM::Text::new, + *Everything::Node::nodegroup::genBasicTag ); + + my @xd; + *XML::DOM::Text::new = sub { + push @xd, [@_]; + return @_; + }; + *XML::DOM::Element::new = sub { + push @xd, [@_]; + return $node; + }; + + my @gbt; + *Everything::Node::nodegroup::genBasicTag = sub { + push @gbt, [@_]; + }; + + $node->{group} = [ 3, 4, 5 ]; + $node->clear(); + $result = fieldToXML( $node, 'doc', 'group', "\r" ); + + is( + join( ' ', @{ $xd[0] } ), + 'XML::DOM::Element doc group', + '... otherwise, it should create a new DOM group element' + ); + + my $count; + for ( 1 .. 6 ) + { + ( $method, $args ) = $node->next_call(); + $count++ if $method eq 'appendChild'; + } + + is( $count, 6, '... appending each child as a Text node' ); + is( join( ' ', map { $_->[3] } @gbt ), + '3 4 5', '... noted with their node_ids' ); + is( $method, 'appendChild', '... and appending the whole thing' ); + is( $result, $node, '... and should return the new element' ); + } + + # xmlTag() + my $gcn; + $node->set_always( SUPER => 8 ) + ->set_series( getTagName => '', 'group', 'group' ) + ->set_series( getNodeType => 1, 2, 3 )->set_true('insertIntoGroup') + ->clear(); + + $result = xmlTag( $node, $node ); + is( $node->next_call(), 'getTagName', 'xmlTag() should get the tag name' ); + is( $node->next_call(), 'SUPER', + '... calling SUPER() if it is not a group tag' ); + is( $result, 8, '... returning the results' ); + + $node->clear(); + + { + local *XML::DOM::TEXT_NODE; + *XML::DOM::TEXT_NODE = sub { 3 }; + + $node->node( getChildNodes => sub { return if $gcn++; return ($node) x 3 } + ); + local *Everything::XML::parseBasicTag; + + my @parses = ( + { where => 'where', }, + { + name => 'me', + me => 'node', + } + ); + *Everything::XML::parseBasicTag = sub { + return shift @parses; + }; + $result = xmlTag( $node, $node ); + + is( $gcn, 1, '... but if it is, should get the child nodes' ); + isa_ok( $result, 'ARRAY', + '... and should return existing fixup nodes in something that' ); + + my @inserts; + while ( ( $method, $args ) = $node->next_call() ) + { + push @inserts, $args if $method eq 'insertIntoGroup'; + } + + is( scalar @inserts, 2, '... and should skip text nodes' ); + is( $result->[0]{fixBy}, 'nodegroup', '... should parse nodegroup nodes' ); + is( join( ' ', map { $_->[3] } @inserts ), + '0 1', '... inserting each into the nodegroup in order' ); + is( join( '|', @{ $inserts[0] } ), + "$node|-1|-1|0", '... as a dummy node if a where clause is provided' ); + is( join( '|', @{ $inserts[1] } ), + "$node|-1|node|1", '... or by name if a name is provided' ); + + ok( !xmlTag( $node, $node ), '... should return nothing with no fixups' ); + } + + # applyXMLFix() + $node->set_always( SUPER => 14 )->clear(); + + my $fix = { fixBy => 'foo' }; + $result = applyXMLFix( $node, $fix ); + is( $node->next_call(), 'SUPER', + 'applyXMLFix() should call SUPER() unless handling a nodegroup node' ); + is( $result, 14, '... returning its results' ); + + { + local *Everything::XML::patchXMLwhere; + + my $pxw; + *Everything::XML::patchXMLwhere = sub { + $pxw++; + return { + title => 'title', + field => 'field', + type_nodetype => 'type', + }; + }; + + $node->set_series( getNode => { node_id => 111 }, 0, 0 ); + + $fix = { + fixBy => 'nodegroup', + orderby => 1, + }; + + $result = applyXMLFix( $node, $fix ); + ok( $pxw, '... should call patchXMLwhere() to get the right node data' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'getNode', '... attemping to get the node' ); + is( $args->[1]{type_nodetype}, 'type', '... with the where hashref' ); + is( $node->{group}[1], + 111, '... replacing dummy node with fixed node on success' ); + + $node->{title} = 'title'; + $node->{type} = { title => 'typetitle' }; + + $result = applyXMLFix( $node, $fix, 1 ); + like( + $errors, + qr/Unable to find 'title' of type/, + '... should warn about missing node if error flag is set' + ); + + $errors = ''; + $result = applyXMLFix( $node, $fix ); + is( $errors, '', '... but should not warn without flag' ); + + isa_ok( $result, 'HASH', '... should return fixup data if it failed' ); + } + + # clone() + $node->set_series( SUPER => undef, ($node) x 2 )->set_true('update')->clear(); + + $result = clone( $node, 'user' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'SUPER', 'clone() should call SUPER()' ); + is( $args->[1], 'user', '... with the user' ); + ok( !$result, '... and should return false unless that succeeded' ); + + $node->{group} = 'group'; + $result = clone( $node, 'user' ); + is( $result, $node, '... or the new node if it succeeded' ); + ( $method, $args ) = $node->next_call(2); + is( $method, 'insertIntoGroup', '... inserting the group into the new node' ); + is( join( '-', @$args ), "$node-user-group", + '... with the user and the group' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'update', '... updating the node' ); + is( $args->[1], 'user', '... with the user' ); + + delete $node->{group}; + $node->{_calls} = []; + isnt( $node->{_calls}[1], + 'insertIntoGroup', + '... but should avoid insert without a group in the parent' ); + + # restrict_type() + { + local *Everything::Node::nodegroup::getNode; + + my @nodes = ( 0, 1, 2, 1 ); + my @calls; + *Everything::Node::nodegroup::getNode = sub { + push @calls, [@_]; + my $nodenum = shift @nodes; + return $nodenum + ? { restrict_nodetype => $nodenum, type_nodetype => $nodenum } + : { type => { restrict_nodetype => 1 }, type_nodetype => 0 }; + }; + + $node->{type_nodetype} = 6; + $result = restrict_type( $node, 'group' ); + + is( $calls[0][0], 6, + 'restrict_type() should get the appropriate nodetype' ); + is( $result, 'group', + '... and should return group unchanged if there is no restriction' ); + + $result = restrict_type( $node, [ 1 .. 4 ] ); + is( scalar @calls, 6, '... should get each node in group reference' ); + + isa_ok( $result, 'ARRAY', + '... returning an array reference of proper nodes' ); + + is( scalar @$result, + 3, '... and should save nodes that are of the proper type' ); + is( $result->[2], 4, + '... or group nodes that can contain the proper type' ); + } + + # getNodeKeepKeys() + $node->set_series( SUPER => { keep => 1, me => 1 } )->clear(); + + $result = getNodeKeepKeys($node); + is( $node->next_call(), 'SUPER', 'getNodeKeepKeys() should call SUPER()' ); + isa_ok( $result, 'HASH', '... returning something that' ); + is( scalar keys %$result, 3, '... containing keys from SUPER() and an extra' ); + ok( $result->{group}, '... and one key should be "group"' ); + + # conflictsWith() + $node->{modified} = ''; + ok( !conflictsWith($node), + 'conflictsWith() should return false with no number in "modified" field' ); + + $node->{modified} = 7; + $node->{group} = [ 1, 4, 6, 8 ]; + + $node->set_always( SUPER => 11 )->clear(); + + my $group = { group => [ 1, 4, 6 ] }; + is( conflictsWith( $node, $group ), + 1, '... should return true if groups are different sizes' ); + + push @{ $group->{group} }, 9; + is( conflictsWith( $node, $group ), + 1, '... should return true if a node conflicts between the two nodes' ); + + $result = conflictsWith( $node, $node ); + is( $node->next_call(), 'SUPER', '... calling SUPER() if that succeeds' ); + is( $result, 11, '... returning the result' ); Property changes on: trunk/ebase/lib/Everything/Node/Test/nodegroup.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/nodegroup.pm =================================================================== --- trunk/ebase/lib/Everything/Node/nodegroup.pm 2006-05-04 20:16:19 UTC (rev 852) +++ trunk/ebase/lib/Everything/Node/nodegroup.pm 2006-05-04 21:39:25 UTC (rev 853) @@ -21,11 +21,9 @@ sub construct { - my ($this) = @_; + my ($this) = @_; + $$this{group} = $this->selectGroupArray(); - my $group = $this->selectGroupArray(); - $$this{group} = $group; - # We could call selectNodegroupFlat() here to have that info ready. # However, since that info may not be needed all the time, we will # save the CPU time and memory space and not call it. If you need @@ -42,16 +40,15 @@ sub selectGroupArray { - my ($this) = @_; + my ($this) = @_; my $groupTable = $this->isGroup(); # Make sure the table exists first - $$this{DB}->createGroupTable($groupTable); + $this->{DB}->createGroupTable($groupTable); # construct our array of node id's of the nodes in our group - my $cursor = $$this{DB}->sqlSelectMany( - 'node_id', $groupTable, - $groupTable . "_id=$$this{node_id}", + my $cursor = $this->{DB}->sqlSelectMany( + 'node_id', $groupTable, $groupTable . "_id=$$this{node_id}", 'ORDER BY orderby' ); return unless $cursor; @@ -80,15 +77,13 @@ { my ( $this, $USER ) = @_; - return 0 unless $USER and $this->hasAccess( $USER, 'c' ); - # We need to h4x0r this a bit. node::insert clears the $this hash. # This clears all fields (including our group field). Normally, # we would insert the group nodes first, but the problem is, this # node has not been inserted yet, so we don't have a node id to # insert them with. So, we hold onto the group array for now. my $group = $this->{group}; - my $return = $this->SUPER(); + my $return = $this->SUPER( $USER ); # Now that the node has been inserted, we need to reassign our group # array. @@ -102,10 +97,9 @@ sub update { my ( $this, $USER ) = @_; - $this->updateGroup($USER); - my $return = $this->SUPER(); - return $return; + $this->updateGroup($USER); + return $this->SUPER( $USER ); } sub updateFromImport @@ -115,7 +109,7 @@ $this->{group} = $NEW->{group}; $this->updateGroup($USER); - return $this->SUPER(); + return $this->SUPER( $NEW, $USER ); } =head2 C<updateGroup> @@ -163,7 +157,7 @@ return 0 unless $USER and $this->hasAccess( $USER, 'w' ); - my $group = $this->restrict_type( $this->{group} ); + my $group = $this->restrict_type( $this->{group} ); my %DIFF; my $updated = 0; @@ -232,8 +226,8 @@ # Find what the current max rank of the group is. my $rank = - $this->{DB}->sqlSelect( 'MAX(rank)', $table, - $table . "_id=$this->{node_id}" ); + $this->{DB}->sqlSelect( 'max(rank)', $table, + $table . "_id=?", '', [ $this->{node_id} ] ); $rank ||= 0; @@ -244,11 +238,10 @@ $this->{DB}->sqlInsert( $table, { - $table . - "_id" => $this->{node_id}, - rank => $rank, - node_id => $node, - orderby => 0, + $table . "_id" => $this->{node_id}, + rank => $rank, + node_id => $node, + orderby => 0, } ); Modified: trunk/ebase/t/Node/nodegroup.t =================================================================== --- trunk/ebase/t/Node/nodegroup.t 2006-05-04 20:16:19 UTC (rev 852) +++ trunk/ebase/t/Node/nodegroup.t 2006-05-04 21:39:25 UTC (rev 853) @@ -1,8 +1,14 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; +=cut +use Everything::Node::Test::nodegroup; +Everything::Node::Test::nodegroup->runtests(); + +__END__ + +=cut + BEGIN { chdir 't' if -d 't'; @@ -12,7 +18,7 @@ use vars qw( $AUTOLOAD $errors ); use Test::MockObject; -use Test::More tests => 180; +use Test::More tests => 177; my $module = 'Everything::Node::nodegroup'; use_ok( $module ) or exit; @@ -99,21 +105,14 @@ # insert() $mock->set_series( hasAccess => ( 0, 1 ) )->set_true('updateGroup')->clear(); -ok( !insert( $mock, 'user' ), - 'insert() should return false if user cannot create node' ); -( $method, $args ) = $mock->next_call(); -is( $method, 'hasAccess', '... calling hasAccess to check' ); -is( join( '-', @$args ), "$mock-user-c", '... user create permissions' ); - $mock->{group} = 'foo'; -ok( insert( $mock, 'user2' ), '... should return node_id if check succeeds' ); -is( $mock->next_call(2), 'SUPER', '... calling SUPER()' ); +ok( insert( $mock, 'user2' ), + 'insert() should return node_id if check succeeds' ); +is( $mock->next_call(), 'SUPER', '... calling SUPER()' ); ( $method, $args ) = $mock->next_call(); is( $method, 'updateGroup', '... calling updateGroup()' ); is( $args->[1], 'user2', '... with user' ); -ok( !insert($mock), '... and should return false with no user provided' ); - # update() $mock->set_always( SUPER => 4 )->clear(); @@ -172,11 +171,9 @@ ( $method, $args ) = $mock->next_call(); is( $method, 'sqlSelect', '... selecting max rank if inserting' ); -is( - join( '-', @$args ), - "$mock-MAX(rank)-gtable-gtable_id=411", - '... from proper table' -); +is( join( '-', @$args[1 .. 3] ), 'max(rank)-gtable-gtable_id=?', + '... from proper table' ); +is( $args->[5][0], 411, '... with proper id' ); ( $method, $args ) = $mock->next_call(); is( $method, 'sqlInsert', '... and should insert new nodes' ); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-05 19:38:10
|
Revision: 854 Author: chromatic Date: 2006-05-05 12:37:56 -0700 (Fri, 05 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=854&view=rev Log Message: ----------- r16507@windwheel: chromatic | 2006-05-05 12:37:41 -0700 Ported more nodegroup tests to the new form. Modified Paths: -------------- trunk/ebase/lib/Everything/Node/Test/nodegroup.pm trunk/ebase/lib/Everything/Node/nodegroup.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16505 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16507 Modified: trunk/ebase/lib/Everything/Node/Test/nodegroup.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/nodegroup.pm 2006-05-04 21:39:25 UTC (rev 853) +++ trunk/ebase/lib/Everything/Node/Test/nodegroup.pm 2006-05-05 19:37:56 UTC (rev 854) @@ -208,219 +208,267 @@ '... assigning new group to the node' ); } -1; -__END__ - - # nuke() +sub test_nuke :Test( 7 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $node->{node_id} = 7; - $node->{dbh} = $node; - $node->set_always( SUPER => 12 )->set_always( isGroup => 'table' ) - ->set_series( hasAccess => ( 1, 0 ) )->set_true('getRef')->clear(); + $node->set_always( SUPER => 12 ) + ->set_always( isGroup => 'table' ) + ->set_true( -hasAccess ); + $db->set_true(qw( getRef sqlDelete )); - is( nuke( $node, 'user' ), 12, 'nuke() should return result of SUPER() call' ); - is( $node->next_call(), 'isGroup', '... should fetch group table' ); - is( $node->next_call(), 'getRef', '... should nodify user parameter' ); - ( $method, $args ) = $node->next_call(); - is( $method, 'hasAccess', '... should check for access' ); - is( join( '-', @$args ), "$node-user-d", '... user delete access' ); - ( $method, $args ) = $node->next_call(); + is( $node->nuke( 'user' ), 12, + 'nuke() should return result of SUPER() call' ); + + is( $node->next_call(), 'isGroup', '... fetching group table' ); + is( $db->next_call(), 'getRef', '... and nodifying user parameter' ); + + my ( $method, $args ) = $db->next_call(); is( $method, 'sqlDelete', '... and should delete the node' ); - is( join( '-', @$args ), "$node-table-table_id=7", '... with the proper id' ); + is( join( '-', @$args ), "$db-table-table_id=7", + '... with the proper id' ); - is( $node->next_call(), 'SUPER', '... calling SUPER' ); - ok( !nuke( $node, '' ), '... returning false if user cannot nuke this node' ); + ( $method, $args ) = $node->next_call(); + is( $method, 'SUPER', '... calling SUPER' ); + is( $args->[1], 'user', '... passing $USER' ); +} - # isGroup() +sub test_is_group :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; $node->{type}{derived_grouptable} = 77; - is( isGroup($node), 77, 'isGroup() should return derived group table' ); + is( $node->isGroup(), 77, 'isGroup() should return derived group table' ); +} - # inGroupFast() +sub test_in_group_fast :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + $node->{group} = [ 1, 3, 5, 7, 17, 43 ]; - $node->set_series( getId => 17, 44 )->set_true('groupCache') - ->set_always( 'existsInGroupCache', 'cached?' )->clear(); + $db->set_series( getId => 17, 44 ); + $node->set_true('groupCache') + ->set_always( 'existsInGroupCache', 'cached?' ); - $result = inGroupFast( $node, 'node!' ); - ( $method, $args ) = $node->next_call(); - is( $method, 'getId', 'inGroupFast() should find node_id' ); - is( $args->[1], 'node!', '... of node' ); + my $result = $node->inGroupFast( 'node!' ); + + my ( $method, $args ) = $db->next_call(); + is( $method, 'getId', 'inGroupFast() should find node_id' ); + is( $args->[1], 'node!', '... of node' ); is( $node->next_call(), 'groupCache', '... populating cache' ); - is( $result, 'cached?', '... returning result of cache lookup' ); + is( $result, 'cached?', '... returning result of cache lookup' ); +} - # inGroup() - ok( !inGroup($node), 'inGroup() should return false if no node is provided' ); +sub test_in_group :Test( 10 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; - $node->set_always( selectNodegroupFlat => 'flat' ) - ->set_always( getId => 'node_id' )->set_series( hasGroupCache => ( 0, 1 ) ) - ->set_always( existsInGroupCache => 'cached?' )->clear(); + ok( ! $node->inGroup(), + 'inGroup() should return false with no node provided' ); - $result = inGroup( $node, 'foo' ); - ( $method, $args ) = $node->next_call(); - is( $method, 'getId', '... should make sure it has a node_id' ); + $node->set_always( -selectNodegroupFlat => 'flat' ) + ->set_series( -hasGroupCache => ( 0, 1 ) ) + ->set_always( existsInGroupCache => 'cached?' ) + ->set_true( 'groupCache' ); + $db->set_always( getId => 'node_id' ); + + my $result = $node->inGroup( 'foo' ); + my ( $method, $args ) = $db->next_call(); + is( $method, 'getId', '... ensuring that it has a node_id' ); is( $args->[1], 'foo', '... with the node parameter' ); ( $method, $args ) = $node->next_call(); - is( $method, 'hasGroupCache', "... checking if there's a group cache" ); - - ( $method, $args ) = $node->next_call(); - is( $method, 'selectNodegroupFlat', - '... should call selectNodegroupFlat() to get all group members (if not)' ); - - ( $method, $args ) = $node->next_call(); is( $method, 'groupCache', '... caching results' ); - is( $args->[1], 'flat', '... with flat nodegroup' ); + is( $args->[1], 'flat', '... with flat nodegroup' ); ( $method, $args ) = $node->next_call(); is( $method, 'existsInGroupCache', '... checking group cache' ); is( $args->[1], 'node_id', '... with node_id' ); is( $result, 'cached?', '... returning result' ); - $node->clear(); - inGroup( $node, 'bar' ); - is( $node->next_call(3), 'existsInGroupCache', + $node->inGroup( 'bar' ); + is( $node->next_call(), 'existsInGroupCache', '... not rebuilding cache if it exists' ); - ok( !inGroup(), '.... returning false if no node is provided' ); + ok( ! $node->inGroup(), '.... returning false if no node is provided' ); +} - # selectNodegroupFlat() +sub test_select_nodegroup_flat :Test( 10 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + my $group_node = Test::MockObject->new(); + $node->{flatgroup} = 17; - is( selectNodegroupFlat($node), - 17, 'selectNodegroupFlat() should return cached group, if it exists' ); + is( $node->selectNodegroupFlat(), 17, + 'selectNodegroupFlat() should return cached group, if it exists' ); + delete $node->{flatgroup}; + $node->{node_id} = 7; my $traversed = { $node->{node_id} => 1, }; - is( selectNodegroupFlat( $node, $traversed ), - undef, '... or false if it has seen this node before' ); + is( $node->selectNodegroupFlat( $traversed ), undef, + '... or false if it has seen this node before' ); $traversed = {}; - $node->set_series( getNode => ( $node, undef, $node ) ) - ->set_series( isGroup => ( 1, 0 ) ) - ->set_always( selectNodegroupFlat => [ 4, 5 ] )->clear(); + $db->set_series( getNode => ( $group_node, undef, $group_node ) ); + $group_node->set_always( selectNodegroupFlat => [ 4, 5 ] ) + ->set_series( isGroup => ( 1, 0 ) ); $node->{group} = [ 1, 2 ]; - $result = selectNodegroupFlat( $node, $traversed ); - ok( - exists $traversed->{ $node->{node_id} }, - '... should mark this node as seen' - ); + my $result = $node->selectNodegroupFlat( $traversed ); + ok( exists $traversed->{ $node->{node_id} }, + '... marking this node as seen' ); - ( $method, $args ) = $node->next_call(); - is( $method, 'getNode', '... should fetch each node in group' ); + my ( $method, $args ) = $db->next_call(); + is( $method, 'getNode', '... fetching each node in group' ); is( $args->[1], 1, '... by node_id' ); - is( $node->next_call(), 'isGroup', '... checking if node is a group node' ); + is( $group_node->next_call(), 'isGroup', + '... checking if node is a group node' ); - ( $method, $args ) = $node->next_call(); + ( $method, $args ) = $group_node->next_call(); is( $method, 'selectNodegroupFlat', '... fetching group nodes' ); is( $args->[1], $traversed, '... passing traversed hash' ); is( join( ' ', @$result ), '4 5', '... returning list of contained nodes' ); - is( $node->{flatgroup}, $result, '... and should cache group' ); + is( $node->{flatgroup}, $result, '... and caching group' ); +} - # insertIntoGroup() - ok( !insertIntoGroup($node), - 'insertIntoGroup() should return false unless a user is provided' ); - ok( !insertIntoGroup( $node, 1 ), '... or if no insertables are provided' ); +sub test_insert_into_group :Test( 11 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; - $node->set_series( hasAccess => ( 0, 1, 1 ) ); - ok( - !insertIntoGroup( $node, 'user', 1 ), - '... or if user does not have write access' - ); + $node->{group} = [ 1, 2 ]; + $node->set_true( 'groupUncache' ); - ( $method, $args ) = $node->next_call(2); - is( $method, 'hasAccess', '... so it should check access' ); - is( join( '-', @$args ), "$node-user-w", '... write access for user' ); + ok( ! $node->insertIntoGroup(), + 'insertIntoGroup() should return false without a user' ); + ok( ! $node->insertIntoGroup( 1 ), '... or with no insertables' ); - $node->set_series( restrict_type => ( [ 1 .. 3 ], [4] ) ) - ->set_series( getId => 3, 2, 1, 4 )->clear(); + $node->set_series( -hasAccess => ( 0, 1, 1 ) ); + ok( ! $node->insertIntoGroup( 'user', 1 ), + '... or if user lacks write access' ); - insertIntoGroup( $node, 'user', 1, 1 ); - ( $method, $args ) = $node->next_call(2); + $node->set_series( restrict_type => ( [ 1 .. 3 ], [4] ) ); + $db->set_series( getId => 3, 2, 1, 4 ); - is( $method, 'restrict_type', '... checking for type restriction on group' ); + $node->insertIntoGroup( 'user', 1, 1 ); + my ( $method, $args ) = $node->next_call(); + + is( $method, 'restrict_type', '... checking for group type restriction' ); isa_ok( $args->[1], 'ARRAY', '... allowing an insertion refs that is scalar or' ); my $count; - while ( $method = $node->next_call() ) + while ( $method = $db->next_call() ) { $count++ if $method eq 'getId'; } - is( $count, 3, '... should get node id of insertion' ); + is( $count, 3, '... getting node id of insertion' ); is( join( ' ', @{ $node->{group} } ), - '1 3 2 1 2', '... should update "group" field' ); - ok( !exists $node->{flatgroup}, '... and delete "flatgroup" field' ); - ok( insertIntoGroup( $node, 'user', 1 ), '... should return true on success' ); - is( join( ' ', @{ $node->{group} } ), - '1 3 2 1 2 4', '... appending new nodes if no position is given' ); + '1 3 2 1 2', '... updating "group" field' ); + ok( ! exists $node->{flatgroup}, '... and deleting "flatgroup" field' ); + ok( $node->insertIntoGroup( 'user', 1 ), '... returning true on success' ); + is( join( ' ', @{ $node->{group} } ), '1 3 2 1 2 4', + '... appending new nodes with no position given' ); + is( $node->next_call(), 'groupUncache', '... and clearing cache' ); +} - # removeFromGroup() - ok( !removeFromGroup($node), - 'removeFromGroup() should return false unless a user is provided' ); - ok( !removeFromGroup( $node, 'user' ), - '... or if no insertables are provided' ); +sub test_remove_from_group :Test( 7 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; - $node->set_series( hasAccess => ( 0, 1 ) )->clear(); + ok( ! $node->removeFromGroup(), + 'removeFromGroup() should return false without a user' ); + ok( ! $node->removeFromGroup( 'user' ), '... or without insertables' ); - ok( - !removeFromGroup( $node, 6, 'user' ), - '... or if user does not have write access' - ); - ( $method, $args ) = $node->next_call(); - is( $method, 'hasAccess', '... checking for access' ); - is( join( '-', @$args ), "$node-user-w", '... write access for user' ); + $node->set_series( -hasAccess => 0, 1 ) + ->set_true( 'groupUncache' ); - $node->set_always( hasAccess => (1) )->set_always( getId => (6) )->clear(); + ok( ! $node->removeFromGroup( 6, 'user' ), + '... or if user lacks write access' ); - $node->{_calls} = []; + $db->set_always( getId => 6 ); + $node->{group} = [ 3, 6, 9, 12 ]; - $result = removeFromGroup( $node, 6, 'user' ); - ( $method, $args ) = $node->next_call(2); - is( $method, 'getId', '... should get node_id' ); - is( $args->[1], 6, '... of removable node' ); + my $result = $node->removeFromGroup( 6, 'user' ); - is( join( ' ', @{ $node->{group} } ), - '3 9 12', '... should assign new "group" field without removed node' ); - ok( $result, '... should return true on success' ); - ok( !exists $node->{flatgroup}, '... deleting the cached flat group' ); + is( join( ' ', @{ $node->{group} } ), '3 9 12', + '... assign new "group" field without removed node' ); + ok( $result, '... returning true on success' ); + ok( ! exists $node->{flatgroup}, '... deleting the cached flat group' ); is( $node->next_call(), 'groupUncache', '... and uncaching group' ); +} - # replaceGroup() - $node->set_series( isGroup => ( '', 'table' ) )->set_series( hasAccess => 0, 1 ) - ->set_always( restrict_type => 'abc' )->clear(); +sub test_replace_group :Test( 8 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; - $result = replaceGroup( $node, 'replace', 'user' ); + $node->set_series( isGroup => ( '', 'table' ) ) + ->set_series( -hasAccess => 0, 1 ) + ->set_always( restrict_type => 'abc' ) + ->set_true( 'groupUncache' ); - is( $node->next_call(), 'isGroup', 'replaceGroup() should fetch group table' ); - ok( !$result, '... should return false if user does not have write access' ); - ( $method, $args ) = $node->next_call(); - is( $method, 'hasAccess', '... checking for access' ); - is( join( '-', @$args ), "$node-user-w", '... write access for user' ); + my $result = $node->replaceGroup( 'replace', 'user' ); + is( $node->next_call(), 'isGroup', + 'replaceGroup() should fetch group table' ); + ok( ! $result, '... returning false unless user has write access' ); + $node->{group} = $node->{flatgroup} = 123; - $result = replaceGroup( $node, 'replace', 'user' ); + $result = $node->replaceGroup( 'replace', 'user' ); - ( $method, $args ) = $node->next_call(3); + my ( $method, $args ) = $node->next_call(2); is( $method, 'restrict_type', '... restricting types of new group' ); - isa_ok( $args->[1], 'ARRAY', '... constraining argument to something that ' ); + isa_ok( $args->[1], 'ARRAY', + '... constraining argument to something that ' ); is( $node->{group}, 'abc', - '... should replace existing "group" field with new group' ); - ok( !exists $node->{flatgroup}, '... and should delete any "flatgroup" field' ); + '... replacing existing "group" field with new group' ); + ok( !exists $node->{flatgroup}, '... and deleting any "flatgroup" field' ); is( $node->next_call(), 'groupUncache', '... uncaching group' ); - ok( $result, '... should return true on success' ); + ok( $result, '... returning true on success' ); +} - # getNodeKeys() - $node->set_series( SUPER => { foo => 1 }, { foo => 2 } )->clear(); +sub test_get_node_keys :Test( 5 ) +{ + my $self = shift; + my $node = $self->{node}; - $result = getNodeKeys( $node, 1 ); - is( $node->next_call(), 'SUPER', + $node->set_series( SUPER => { foo => 1 }, { foo => 2 } ); + + my $result = $node->getNodeKeys( 1 ); + my ($method, $args) = $node->next_call(); + + is( $method, 'SUPER', 'getNodeKeys() should call SUPER() to get parent type keys' ); + is( $args->[1], 1, '... passing export flag' ); + isa_ok( $result, 'HASH', '... should return a hash reference of keys' ); + ok( exists $result->{group}, '... including a group key if the forExport flag is set' ); - ok( !exists getNodeKeys($node)->{group}, '... excluding it otherwise' ); + ok( !exists $node->getNodeKeys()->{group}, '... excluding it otherwise' ); +} +1; +__END__ + # fieldToXML() $node->set_series( SUPER => ( 5, 6, 7 ) )->set_true('appendChild')->clear(); Modified: trunk/ebase/lib/Everything/Node/nodegroup.pm =================================================================== --- trunk/ebase/lib/Everything/Node/nodegroup.pm 2006-05-04 21:39:25 UTC (rev 853) +++ trunk/ebase/lib/Everything/Node/nodegroup.pm 2006-05-05 19:37:56 UTC (rev 854) @@ -330,7 +330,7 @@ $$this{DB}->sqlDelete( $table, $table . "_id=$this->{node_id}" ); # Now go delete the node! - $this->SUPER(); + $this->SUPER( $USER ); } sub isGroup @@ -558,12 +558,7 @@ my $group = $this->{group}; # manipulate group in place for a speed boost - my $pos = -1; - while ( $pos < $#{$group} ) - { - $pos++, next unless $group->[$pos] == $node_id; - splice( @$group, $pos, 1 ); - } + $this->{group} = [ grep { $_ != $node_id } @$group ]; # If a flatgroup exists, it is no longer valid. delete $this->{flatgroup}; @@ -624,11 +619,10 @@ sub getNodeKeys { my ( $this, $forExport ) = @_; - my $keys = $this->SUPER(); + my $keys = $this->SUPER( $forExport ); if ($forExport) { - # Groups are special. There is one field that we do want to # include for export... the group field that is generated # when the group node is constructed. This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-09 23:37:23
|
Revision: 856 Author: chromatic Date: 2006-05-09 16:37:11 -0700 (Tue, 09 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=856&view=rev Log Message: ----------- r16551@windwheel: chromatic | 2006-05-09 16:36:57 -0700 Ported tests for nodeball node to Test::Class style. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/nodeball.pm trunk/ebase/t/Node/nodeball.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/nodeball.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16549 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16551 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-08 22:10:47 UTC (rev 855) +++ trunk/ebase/MANIFEST 2006-05-09 23:37:11 UTC (rev 856) @@ -90,6 +90,7 @@ lib/Everything/Node/Test/dbtable.pm lib/Everything/Node/Test/htmlcode.pm lib/Everything/Node/Test/node.pm +lib/Everything/Node/Test/nodeball.pm lib/Everything/Node/Test/nodegroup.pm lib/Everything/Node/Test/nodetype.pm lib/Everything/Node/Test/setting.pm Added: trunk/ebase/lib/Everything/Node/Test/nodeball.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/nodeball.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/nodeball.pm 2006-05-09 23:37:11 UTC (rev 856) @@ -0,0 +1,191 @@ +package Everything::Node::Test::nodeball; + +use strict; +use warnings; + +use base 'Everything::Node::Test::nodegroup'; + +use SUPER; +use Test::More; + +*Everything::Node::nodeball::SUPER = \&UNIVERSAL::SUPER; + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $module = $self->node_class(); + can_ok( $module, 'dbtables' ); + my @tables = $module->dbtables(); + is_deeply( \@tables, [ 'setting', 'node' ], + 'dbtables() should return node tables' ); +} + +sub test_extends :Test( +1 ) +{ + my $self = shift; + my $module = $self->node_class(); + ok( $module->isa( 'Everything::Node::nodegroup' ), + "$module should extend nodegroup" ); + $self->SUPER(); +} + +sub test_insert :Test( 10 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->set_true( 'setVars' ) + ->set_series( SUPER => 0, 1, 0 ) + ->set_series( getVars => 1 ); + + $node->{title} = 'title!'; + + $db->set_series( getNode => '', $node ); + $self->{errors} = []; + + is( $node->insert( 'user' ), 0, + 'insert() should return 0 if SUPER() insert fails' ); + + like( $self->{errors}[0][0], qr/bad insert id:/, '... logging error' ); + ok( exists $node->{vars}, '... vivifying node "vars" field' ); + + is( $node->next_call(), 'getVars', '... and calling getVars() on node' ); + + my ($method, $args) = $node->next_call(); + is( $method, 'SUPER', '... calling super method' ); + is( $args->[1], 'user', '... and passing user' ); + + is( $node->insert( 2 ), 1, '... returning node_id if insert succeeds' ); + + ( $method, $args ) = $node->next_call(2); + is( $method, 'setVars', '... calling setVars()' ); + is_deeply( $args->[1], + { + author => 'ROOT', + version => '0.1.1', + description => 'No description', + }, '... with default vars' ); + + $node->clear(); + $node->insert(); + + ( $method, $args ) = $node->next_call(2); + is( $args->[1]->{author}, 'title!', + '... respecting given title when creating default vars' ); +} + +sub test_get_vars :Test( 2 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( getHash => 10 ); + + is( $node->getVars(), 10, 'getVars() should call getHash()' ); + my ( $method, $args ) = $node->next_call(); + is( $args->[1], 'vars', '... with appropriate arguments' ); +} + +sub test_set_vars :Test( 2 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( setHash => 11 ); + + is( $node->setVars( 12 ), 11, 'setVars() should call setHash()' ); + my ( $method, $args ) = $node->next_call(); + is( join( '-', @$args ), "$node-12-vars", '... with appropriate args' ); +} + +sub test_has_vars :Test( 1 ) +{ + my $self = shift; + my $node = $self->{node}; + + ok( $node->hasVars(), 'hasVars() should return true' ); +} + +sub test_field_to_XML :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + + my @saveargs; + local *Everything::Node::setting::fieldToXML; + *Everything::Node::setting::fieldToXML = sub { @saveargs = @_ }; + + my @args = ( 'doc', '', 1 ); + $node->set_always( SUPER => 4 ); + + is( $node->fieldToXML(@args), 4, + 'fieldToXML() should call SUPER() unless handling a "vars" field' ); + + my ($method, $args) = $node->next_call(); + is_deeply( $args, [ $node, @args ], '... passing all arguments' ); + + $args[1] = 'vars'; + is( $node->fieldToXML( @args ), 4, + '... delegating to setting nodetype if handling "vars" field' ); + is( "@saveargs", "$node @args", '... passing along its arguments' ); +} + +sub test_xml_tag :Test( 5 ) +{ + my $self = shift; + my $node = $self->{node}; + + my @saveargs; + local *Everything::Node::setting::xmlTag; + *Everything::Node::setting::xmlTag = sub { + @saveargs = @_; + }; + + $node->set_always( SUPER => 1 ) + ->set_series( getTagName => 0, 'vars' ); + + is( $node->xmlTag( $node ), 1, + 'xmlTag() should call SUPER() unless XMLifying a "vars" field' ); + + # handle these out of order + my $method = $node->next_call(); + (undef, my $args) = $node->next_call(); + is( $args->[1], $node, '... passing tag' ); + + is( $method, 'getTagName', '... calling getTagName() on tag' ); + + is( $node->xmlTag( $node ), 2, + '... delegating to settings node if passed "vars" field' ); + is( "$node $node", "@saveargs", '... passing node and tag' ); +} + + +sub test_apply_xml_fix :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + + my @saveargs; + local *Everything::Node::setting::applyXMLFix; + *Everything::Node::setting::applyXMLFix = sub { @saveargs = @_ }; + + my $fix = { fixBy => '' }; + my @args = ( $fix, 1 ); + + $node->set_always( SUPER => 18 ); + + is( $node->applyXMLFix( @args ), 18, + 'applyXMLFix() should call SUPER() unless fixing up "setting" node' ); + + my ($method, $args) = $node->next_call(); + is_deeply( $args, [ $node, $fix, 1 ], '... passing args' ); + + $fix->{fixBy} = 'setting'; + + is( $node->applyXMLFix( @args ), 3, + '... delegating to setting nodetype when fixing "setting" field' ); + is( "@saveargs", "$node @args", '... and should pass same arguments' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/nodeball.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/nodeball.pm =================================================================== --- trunk/ebase/lib/Everything/Node/nodeball.pm 2006-05-08 22:10:47 UTC (rev 855) +++ trunk/ebase/lib/Everything/Node/nodeball.pm 2006-05-09 23:37:11 UTC (rev 856) @@ -37,10 +37,9 @@ sub insert { my ( $this, $USER ) = @_; - $this->{vars} ||= ''; + $this->{vars} ||= ''; + my $VARS = $this->getVars(); - my $VARS = $this->getVars(); - # If the node was not inserted with some vars, we need to set some. unless ($VARS) { @@ -59,7 +58,7 @@ $this->setVars( $VARS, $USER ); } - my $insert_id = $this->SUPER(); + my $insert_id = $this->SUPER( $USER ); return $insert_id if $insert_id; Everything::logErrors("Got bad insert id: $insert_id!"); @@ -97,20 +96,20 @@ return Everything::Node::setting::fieldToXML( $this, $DOC, $field, $indent ) if $field eq 'vars'; - return $this->SUPER(); + return $this->SUPER( $DOC, $field, $indent ); } sub xmlTag { my ( $this, $TAG ) = @_; - my $tagname = $TAG->getTagName(); + my $tagname = $TAG->getTagName(); # Since we derive from nodegroup, but also have some setting type # functionality, we need to use the setting stuff here. return Everything::Node::setting::xmlTag( $this, $TAG ) if $tagname =~ /vars/i; - return $this->SUPER(); + return $this->SUPER( $TAG ); } sub applyXMLFix @@ -120,7 +119,7 @@ return Everything::Node::setting::applyXMLFix( $this, $FIX, $printError ) if $FIX->{fixBy} eq 'setting'; - return $this->SUPER(); + return $this->SUPER( $FIX, $printError ); } 1; Modified: trunk/ebase/t/Node/nodeball.t =================================================================== --- trunk/ebase/t/Node/nodeball.t 2006-05-08 22:10:47 UTC (rev 855) +++ trunk/ebase/t/Node/nodeball.t 2006-05-09 23:37:11 UTC (rev 856) @@ -1,156 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 29; -use Test::MockObject; - -my ( $method, $args, $result ); -my $mock = Test::MockObject->new(); - -my $module = 'Everything::Node::nodeball'; -use_ok( $module ) or exit; - -ok( $INC{'Everything.pm'}, 'nodeball should use Everything' ); - -ok( $module->isa( 'Everything::Node::nodegroup' ), - 'nodeball should extend nodegroup' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( setting node )], - 'dbtables() should return node tables' ); - -# insert() -{ - my ( $error, $vars ); - - local ( *Everything::logErrors, *insert ); - - *Everything::logErrors = sub { $error = shift }; - $mock->set_true('setVars')->set_series( SUPER => 0, 1, 0 )->set_series( - getNode => '', - bless { title => 'title' }, 'Everything::Node' - )->set_series( getVars => 1 ); - - *insert = \&Everything::Node::nodeball::insert; - - $mock->{DB} = $mock; - - is( insert($mock), 0, 'insert() should return 0 if SUPER() insert fails' ); - like( $error, qr/bad insert id:/, '... and should log error' ); - ok( exists $mock->{vars}, '... should vivify node "vars" field' ); - - is( $mock->next_call(), 'getVars', '... and call getVars() on node' ); - is( $mock->next_call(), 'SUPER', '... calling super method' ); - - is( insert( $mock, 2 ), 1, '... should return node_id if insert succeeds' ); - - ( $method, $args ) = $mock->next_call(3); - is( $method, 'setVars', '... calling setVars()' ); - is_deeply( - $args->[1], - { - author => 'ROOT', - version => '0.1.1', - description => 'No description', - }, - '... with default vars' - ); - - $mock->clear(); - - insert($mock); - ( $method, $args ) = $mock->next_call(3); - is( $args->[1]->{author}, - 'title', '... should respect given title when creating default vars' ); -} - -# getVars() -$mock->set_always( getHash => 10 )->clear(); - -is( Everything::Node::nodeball::getVars($mock), - 10, 'getVars() should call getHash()' ); -( $method, $args ) = $mock->next_call(); -is( $args->[1], 'vars', '... with appropriate arguments' ); - -# setVars() -$mock->set_always( setHash => 11 ); - -is( Everything::Node::nodeball::setVars( $mock, 12 ), - 11, 'setVars() should call setHash()' ); -( $method, $args ) = $mock->next_call(); -is( join( '-', @$args ), "$mock-12-vars", '... with appropriate arguments' ); - -# hasVars() -ok( Everything::Node::nodeball::hasVars(), 'hasVars() should return true' ); - -# fieldToXML() -{ - my @saveargs; - local *Everything::Node::setting::fieldToXML; - *Everything::Node::setting::fieldToXML = sub { - @saveargs = @_; - }; - - my @args = ( $mock, 'doc', '', 1 ); - $mock->set_always( SUPER => 4 )->clear(); - - is( Everything::Node::nodeball::fieldToXML(@args), - 4, 'fieldToXML() should call SUPER() unless handling a "vars" field' ); - - $args[2] = 'vars'; - is( scalar Everything::Node::nodeball::fieldToXML(@args), - 4, '... should delegate to setting nodetype if handling "vars" field' ); - is( "@saveargs", "@args", '... passing along its arguments' ); -} - -# xmlTag() -{ - my @saveargs; - local *Everything::Node::setting::xmlTag; - *Everything::Node::setting::xmlTag = sub { - @saveargs = @_; - }; - - $mock->set_always( SUPER => 1 )->set_series( getTagName => 0, 'vars' ) - ->clear(); - - is( Everything::Node::nodeball::xmlTag( $mock, $mock ), - 1, 'xmlTag() should call SUPER() unless XMLifying a "vars" field' ); - is( $mock->next_call(), 'getTagName', '... calling getTagName() on tag' ); - - is( scalar Everything::Node::nodeball::xmlTag( $mock, $mock ), - 2, '... should delegate to settings node if passed "vars" field' ); - is( "$mock $mock", "@saveargs", '... passing node and tag' ); -} - -# applyXMLFix() -{ - my @saveargs; - local *Everything::Node::setting::applyXMLFix; - *Everything::Node::setting::applyXMLFix = sub { - @saveargs = @_; - }; - - my $fix = { fixBy => '' }; - my @args = ( $mock, $fix, 1 ); - - $mock->set_always( SUPER => 18 ); - - is( Everything::Node::nodeball::applyXMLFix(@args), - 18, - 'applyXMLFix() should call SUPER() unless fixing up "setting" field' ); - $fix->{fixBy} = 'setting'; - is( scalar Everything::Node::nodeball::applyXMLFix(@args), - 3, - '... should delegate to setting nodetype when fixing "setting" field' ); - is( "@args", "@saveargs", '... and should pass same arguments' ); -} +use Everything::Node::Test::nodeball; +Everything::Node::Test::nodeball->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-09 23:43:05
|
Revision: 857 Author: chromatic Date: 2006-05-09 16:42:55 -0700 (Tue, 09 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=857&view=rev Log Message: ----------- r16553@windwheel: chromatic | 2006-05-09 16:42:26 -0700 Ported themesetting tests to the new style. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/t/Node/themesetting.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/themesetting.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16551 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16553 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-09 23:37:11 UTC (rev 856) +++ trunk/ebase/MANIFEST 2006-05-09 23:42:55 UTC (rev 857) @@ -94,6 +94,7 @@ lib/Everything/Node/Test/nodegroup.pm lib/Everything/Node/Test/nodetype.pm lib/Everything/Node/Test/setting.pm +lib/Everything/Node/Test/themesetting.pm lib/Everything/Node/Test/user.pm lib/Everything/Nodeball.pm lib/Everything/NodeBase.pm Added: trunk/ebase/lib/Everything/Node/Test/themesetting.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/themesetting.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/themesetting.pm 2006-05-09 23:42:55 UTC (rev 857) @@ -0,0 +1,32 @@ +package Everything::Node::Test::themesetting; + +use strict; +use warnings; + +use base 'Everything::Node::Test::setting'; + +use SUPER; +use Test::More; +*Everything::Node::themesetting::SUPER = \&UNIVERSAL::SUPER; + +sub test_extends :Test( +1 ) +{ + my $self = shift; + my $module = $self->node_class(); + + ok( $module->isa( 'Everything::Node::setting' ), + 'theme should extend setting' ); + $self->SUPER(); +} + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $module = $self->node_class(); + + can_ok( $module, 'dbtables' ); + + my @tables = $module->dbtables(); + is_deeply( \@tables, [qw( themesetting setting node )], + 'dbtables() should return node tables' ); +} Property changes on: trunk/ebase/lib/Everything/Node/Test/themesetting.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/t/Node/themesetting.t =================================================================== --- trunk/ebase/t/Node/themesetting.t 2006-05-09 23:37:11 UTC (rev 856) +++ trunk/ebase/t/Node/themesetting.t 2006-05-09 23:42:55 UTC (rev 857) @@ -1,26 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 4; -use SUPER; -local *Everything::Node::setting::SUPER; -*Everything::Node::setting::SUPER = \&UNIVERSAL::SUPER; - -my $module = 'Everything::Node::themesetting'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::setting' ), - 'theme should extend setting' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( themesetting setting node )], - 'dbtables() should return node tables' ); +use Everything::Node::Test::themesetting; +Everything::Node::Test::themesetting->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-12 22:15:15
|
Revision: 858 Author: chromatic Date: 2006-05-12 15:14:57 -0700 (Fri, 12 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=858&view=rev Log Message: ----------- r16660@windwheel: chromatic | 2006-05-12 15:14:48 -0700 Ported tests for location node to the new style. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/location.pm trunk/ebase/t/Node/location.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/location.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16553 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16660 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-09 23:42:55 UTC (rev 857) +++ trunk/ebase/MANIFEST 2006-05-12 22:14:57 UTC (rev 858) @@ -89,6 +89,7 @@ lib/Everything/Node/workspace.pm lib/Everything/Node/Test/dbtable.pm lib/Everything/Node/Test/htmlcode.pm +lib/Everything/Node/Test/location.pm lib/Everything/Node/Test/node.pm lib/Everything/Node/Test/nodeball.pm lib/Everything/Node/Test/nodegroup.pm Added: trunk/ebase/lib/Everything/Node/Test/location.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/location.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/location.pm 2006-05-12 22:14:57 UTC (rev 858) @@ -0,0 +1,110 @@ +package Everything::Node::Test::location; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; +use Test::More; +use SUPER; +*Everything::Node::location::SUPER = \&UNIVERSAL::SUPER; + +sub test_nuke :Test( +8 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $db->set_true( 'sqlUpdate' ); + $self->SUPER(); + + $node->set_series( SUPER => -1, 0, 1 ); + $db->clear(); + + $node->{node_id} = 'node_id'; + $node->{loc_location} = 'loc_location'; + + is( $node->nuke( 'user' ), -1, + 'nuke() should return result of SUPER() call' ); + + my ($method, $args) = $node->next_call(); + is( $args->[1], 'user', '... passing user to parent method' ); + + isnt( $db->next_call(), 'sqlUpdate', + '... not calling sqlUpdate() if SUPER() call fails' ); + + $node->nuke( 'user' ); + isnt( $db->next_call(), 'sqlUpdate', + '... or if SUPER() returns invalid node_id' ); + + $node->nuke( 'user'); + ($method, $args) = $db->next_call(); + + is( $method, 'sqlUpdate', + '... but should call sqlUpdate() if SUPER() call succeeds' ); + is( $args->[1], 'node', '... updating node table' ); + is( $args->[2]{loc_location}, 'loc_location', 'updating loc_location' ); + is( $args->[3], 'loc_location=node_id', '... matching node_id' ); +} + +sub test_list_nodes :Test( 5 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->set_always( listNodesWhere => 'lnw' ); + + my $result = $node->listNodes( 'full_flag' ); + my ($method, $args) = $node->next_call(); + + is( $method, 'listNodesWhere', 'listNodes() should call listNodesWhere()' ); + is( $args->[1], '', '... with no WHERE clause' ); + is( $args->[2], '', '... with no ORDER clause' ); + is( $args->[3], 'full_flag', '... passing the full flag' ); + is( $result, 'lnw', '... and returning the results' ); +} + + +sub test_list_nodes_where :Test( 11 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $db->set_false( 'sqlSelectMany' ); + $node->{node_id} = 'node_id'; + + $node->listNodesWhere( 'where', 'an order' ); + my ($method, $args) = $db->next_call(); + + is( $method, 'sqlSelectMany', 'listNodesWhere() should fetch nodes' ); + like( $args->[3], qr/^where loc_loca/, '... adding passed where clause' ); + is( $args->[4], 'an order', '... using passed order clause' ); + + $node->listNodesWhere(); + ($method, $args) = $db->next_call(); + + like( $args->[3], qr/^ loc_loca/, + '... but should use default where clause' ); + is( $args->[4], 'order by title', '... and default order clause' ); + + $db->set_series( fetchrow => 1, 2, undef, 1 ) + ->set_series( sqlSelectMany => undef, $db, $db ) + ->set_true( qw( getRef finish )); + + is( @{ $node->listNodesWhere( '', '', '') }, 0, + '... returning empty array ref without nodes in location' ); + + my $nodes = $node->listNodesWhere( '', '' ); + is( @$nodes, 2, '... returning array ref of found nodes' ); + is( join( '', @$nodes ), '12', '... and the right nodes' ); + ok( !( grep { $_ eq 'getRef' } map { scalar $db->next_call() } 1 .. 5 ), + '... but should not call getRef on nodes without full flag' ); + + $node->listNodesWhere( '', '', 1 ); + ok( ( grep { $_ eq 'getRef' } map { scalar $db->next_call() } 1 .. 5 ), + '... and should call getRef on nodes with full flag' ); + + is( $db->next_call(), 'finish', '... and should finish() cursor' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/location.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/location.pm =================================================================== --- trunk/ebase/lib/Everything/Node/location.pm 2006-05-09 23:42:55 UTC (rev 857) +++ trunk/ebase/lib/Everything/Node/location.pm 2006-05-12 22:14:57 UTC (rev 858) @@ -23,9 +23,9 @@ sub nuke { my ( $this, $USER ) = @_; - my $id = $$this{node_id}; - my $parentLoc = $$this{loc_location}; - my $result = $this->SUPER(); + my $id = $this->{node_id}; + my $parentLoc = $this->{loc_location}; + my $result = $this->SUPER( $USER ); if ( $result > 0 ) { @@ -33,7 +33,7 @@ # Set all the nodes that were in this location to be in the # parent location... deleting a location does not delete all # the nodes inside of it. - $$this{DB}->sqlUpdate( "node", { loc_location => $parentLoc }, + $this->{DB}->sqlUpdate( "node", { loc_location => $parentLoc }, "loc_location=$id" ); } @@ -97,16 +97,16 @@ my ( $this, $where, $order, $full ) = @_; $where ||= ''; $order ||= "order by title"; - $where .= " loc_location='$$this{node_id}'"; + $where .= " loc_location='$this->{node_id}'"; my @nodes; if ( my $csr = - $$this{DB}->sqlSelectMany( "node_id", "node", $where, $order ) ) + $this->{DB}->sqlSelectMany( "node_id", "node", $where, $order ) ) { while ( my $id = $csr->fetchrow() ) { - $$this{DB}->getRef($id) if ($full); + $this->{DB}->getRef($id) if ($full); push @nodes, $id; } Modified: trunk/ebase/t/Node/location.t =================================================================== --- trunk/ebase/t/Node/location.t 2006-05-09 23:42:55 UTC (rev 857) +++ trunk/ebase/t/Node/location.t 2006-05-12 22:14:57 UTC (rev 858) @@ -1,113 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -use vars '$AUTOLOAD'; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use FakeNode; -use Test::More tests => 23; - -my $module = 'Everything::Node::location'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::node' ), 'location should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [ 'node' ], 'dbtables() should return node tables' ); - -my $node = FakeNode->new(); - -# nuke() -$node->{_subs}{SUPER} = [ -1, 0, 1 ]; -$node->{DB} = $node; -$node->{node_id} = 'node_id'; -$node->{loc_location} = 'loc_location'; - -is( nuke($node), -1, 'nuke() should return result of SUPER() call' ); -is( $node->{_calls}->[-1][0], - 'SUPER', '... should not call sqlUpdate() if SUPER() call fails' ); - -nuke($node); -is( $node->{_calls}->[-1][0], - 'SUPER', '... or if SUPER() returns invalid node_id' ); - -nuke($node); -my $call = $node->{_calls}->[-1]; -is( $call->[0], 'sqlUpdate', - '... should call sqlUpdate() if SUPER() call succeeds' ); -is( $call->[1], 'node', '... updating node table' ); -is( $call->[2]{loc_location}, 'loc_location', 'updating loc_location' ); -is( $call->[3], 'loc_location=node_id', '... matching node_id' ); - -# listNodes() -$node->{_calls} = []; -$node->{node_id} = 'node_id'; -$node->{_subs} = { - fetchrow => [ 1, 2, undef, 1 ], - sqlSelectMany => [ undef, $node, $node ], -}; - -local *FakeNode::listNodesWhere; -*FakeNode::listNodesWhere = \&Everything::Node::location::listNodesWhere; - -is( scalar @{ listNodes($node) }, - 0, 'listNodes() should return empty array ref with no nodes in location' ); -like( - join( ' ', @{ $node->{_calls}[0] } ), - qr/sqlSelectMany.+location='node_id'/, - '... should call sqlSelectMany() to find its nodes' -); - -$node->{_calls} = []; -my $nodes = listNodes($node); -is( scalar @$nodes, 2, '... should return array ref of found nodes' ); -is( join( '', @$nodes ), '12', '... and the right nodes' ); -ok( - !( grep { $_->[0] eq 'getRef' } @{ $node->{_calls} } ), - '... but should not call getRef on nodes without full flag' -); - -$node->{_calls} = []; -listNodes( $node, 1 ); -ok( - ( grep { $_->[0] eq 'getRef' } @{ $node->{_calls} } ), - '... and should call getRef on nodes with full flag' -); -is( $node->{_calls}[-1][0], 'finish', '... and should finish() cursor' ); - -# listNodesWhere() -$node->{_calls} = []; -listNodesWhere( $node, 'where', 'an order' ); -$call = $node->{_calls}[0]; -is( $call->[0], 'sqlSelectMany', 'listNodesWhere should fetch nodes' ); -like( $call->[3], qr/^where loc_loca/, '... adding any passed where clause' ); -is( $call->[4], 'an order', '... and using any passed order clause' ); - -listNodesWhere($node); -$call = $node->{_calls}[1]; -like( $call->[3], qr/^ loc_loca/, '... but should use default where clause' ); -is( $call->[4], 'order by title', '... and default order clause' ); - -sub AUTOLOAD -{ - return if $AUTOLOAD =~ /DESTROY$/; - - no strict 'refs'; - $AUTOLOAD =~ s/^main:://; - - my $sub = "Everything::Node::location::$AUTOLOAD"; - - if ( defined &{$sub} ) - { - *{$AUTOLOAD} = \&{$sub}; - goto &{$sub}; - } -} +use Everything::Node::Test::location; +Everything::Node::Test::location->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-12 23:06:11
|
Revision: 860 Author: chromatic Date: 2006-05-12 16:05:56 -0700 (Fri, 12 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=860&view=rev Log Message: ----------- r16664@windwheel: chromatic | 2006-05-12 16:05:46 -0700 Ported tests for document, mail, superdoc, and restricted_superdoc to new style. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/mail.pm trunk/ebase/t/Node/document.t trunk/ebase/t/Node/mail.t trunk/ebase/t/Node/restricted_superdoc.t trunk/ebase/t/Node/superdoc.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/document.pm trunk/ebase/lib/Everything/Node/Test/mail.pm trunk/ebase/lib/Everything/Node/Test/restricted_superdoc.pm trunk/ebase/lib/Everything/Node/Test/superdoc.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16662 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16664 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-12 22:40:28 UTC (rev 859) +++ trunk/ebase/MANIFEST 2006-05-12 23:05:56 UTC (rev 860) @@ -88,13 +88,17 @@ lib/Everything/Node/usergroup.pm lib/Everything/Node/workspace.pm lib/Everything/Node/Test/dbtable.pm +lib/Everything/Node/Test/document.pm lib/Everything/Node/Test/htmlcode.pm lib/Everything/Node/Test/location.pm +lib/Everything/Node/Test/mail.pm lib/Everything/Node/Test/node.pm lib/Everything/Node/Test/nodelet.pm lib/Everything/Node/Test/nodeball.pm lib/Everything/Node/Test/nodegroup.pm lib/Everything/Node/Test/nodetype.pm +lib/Everything/Node/Test/restricted_superdoc.pm +lib/Everything/Node/Test/superdoc.pm lib/Everything/Node/Test/setting.pm lib/Everything/Node/Test/themesetting.pm lib/Everything/Node/Test/user.pm Added: trunk/ebase/lib/Everything/Node/Test/document.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/document.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/document.pm 2006-05-12 23:05:56 UTC (rev 860) @@ -0,0 +1,23 @@ +package Everything::Node::Test::document; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; + +use SUPER; +use Test::More; + +*Everything::Node::document::SUPER = \&UNIVERSAL::SUPER; + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $class = $self->node_class(); + can_ok( $class, 'dbtables' ); + my @tables = $class->dbtables(); + is_deeply( \@tables, [qw( document node )], + 'dbtables() should return node tables' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/document.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/Test/mail.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/mail.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/mail.pm 2006-05-12 23:05:56 UTC (rev 860) @@ -0,0 +1,23 @@ +package Everything::Node::Test::mail; + +use strict; +use warnings; + +use base 'Everything::Node::Test::document'; + +use SUPER; +use Test::More; + +*Everything::Node::document::SUPER = \&UNIVERSAL::SUPER; + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $class = $self->node_class(); + can_ok( $class, 'dbtables' ); + my @tables = $class->dbtables(); + is_deeply( \@tables, [qw( mail document node )], + 'dbtables() should return node tables' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/mail.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/Test/restricted_superdoc.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/restricted_superdoc.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/restricted_superdoc.pm 2006-05-12 23:05:56 UTC (rev 860) @@ -0,0 +1,8 @@ +package Everything::Node::Test::restricted_superdoc; + +use strict; +use warnings; + +use base 'Everything::Node::Test::superdoc'; + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/restricted_superdoc.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Added: trunk/ebase/lib/Everything/Node/Test/superdoc.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/superdoc.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/superdoc.pm 2006-05-12 23:05:56 UTC (rev 860) @@ -0,0 +1,23 @@ +package Everything::Node::Test::superdoc; + +use strict; +use warnings; + +use base 'Everything::Node::Test::document'; + +use SUPER; +use Test::More; + +*Everything::Node::document::SUPER = \&UNIVERSAL::SUPER; + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $class = $self->node_class(); + can_ok( $class, 'dbtables' ); + my @tables = $class->dbtables(); + is_deeply( \@tables, [qw( document node )], + 'dbtables() should return node tables' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/superdoc.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/mail.pm =================================================================== --- trunk/ebase/lib/Everything/Node/mail.pm 2006-05-12 22:40:28 UTC (rev 859) +++ trunk/ebase/lib/Everything/Node/mail.pm 2006-05-12 23:05:56 UTC (rev 860) @@ -22,6 +22,6 @@ sub dbtables { my $self = shift; - return 'mail', $self->SUPER::dbtables(); + return 'mail', $self->SUPER(); } 1; Modified: trunk/ebase/t/Node/document.t =================================================================== --- trunk/ebase/t/Node/document.t 2006-05-12 22:40:28 UTC (rev 859) +++ trunk/ebase/t/Node/document.t 2006-05-12 23:05:56 UTC (rev 860) @@ -1,22 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 4; - -my $module = 'Everything::Node::document'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::node' ), 'document should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( document node )], - 'dbtables() should return node tables' ); +use Everything::Node::Test::document; +Everything::Node::Test::document->runtests(); Modified: trunk/ebase/t/Node/mail.t =================================================================== --- trunk/ebase/t/Node/mail.t 2006-05-12 22:40:28 UTC (rev 859) +++ trunk/ebase/t/Node/mail.t 2006-05-12 23:05:56 UTC (rev 860) @@ -1,23 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 4; - -my $module = 'Everything::Node::mail'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::document' ), - 'mail should extend document' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( mail document node )], - 'dbtables() should return node tables' ); +use Everything::Node::Test::mail; +Everything::Node::Test::mail->runtests(); Modified: trunk/ebase/t/Node/restricted_superdoc.t =================================================================== --- trunk/ebase/t/Node/restricted_superdoc.t 2006-05-12 22:40:28 UTC (rev 859) +++ trunk/ebase/t/Node/restricted_superdoc.t 2006-05-12 23:05:56 UTC (rev 860) @@ -1,23 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 4; - -my $module = 'Everything::Node::restricted_superdoc'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::superdoc' ), - 'restricted_superdoc should extend superdoc' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( document node )], - 'dbtables() should return node tables' ); +use Everything::Node::Test::restricted_superdoc; +Everything::Node::Test::restricted_superdoc->runtests(); Modified: trunk/ebase/t/Node/superdoc.t =================================================================== --- trunk/ebase/t/Node/superdoc.t 2006-05-12 22:40:28 UTC (rev 859) +++ trunk/ebase/t/Node/superdoc.t 2006-05-12 23:05:56 UTC (rev 860) @@ -1,23 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 4; - -my $module = 'Everything::Node::superdoc'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::document' ), - 'theme should extend document' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( document node )], - 'dbtables() should return node tables' ); +use Everything::Node::Test::superdoc; +Everything::Node::Test::superdoc->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-12 22:40:38
|
Revision: 859 Author: chromatic Date: 2006-05-12 15:40:28 -0700 (Fri, 12 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=859&view=rev Log Message: ----------- r16662@windwheel: chromatic | 2006-05-12 15:40:18 -0700 Ported nodelet tests to new system. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/nodelet.pm trunk/ebase/t/Node/nodelet.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/nodelet.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16660 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16662 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-12 22:14:57 UTC (rev 858) +++ trunk/ebase/MANIFEST 2006-05-12 22:40:28 UTC (rev 859) @@ -91,6 +91,7 @@ lib/Everything/Node/Test/htmlcode.pm lib/Everything/Node/Test/location.pm lib/Everything/Node/Test/node.pm +lib/Everything/Node/Test/nodelet.pm lib/Everything/Node/Test/nodeball.pm lib/Everything/Node/Test/nodegroup.pm lib/Everything/Node/Test/nodetype.pm Added: trunk/ebase/lib/Everything/Node/Test/nodelet.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/nodelet.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/nodelet.pm 2006-05-12 22:40:28 UTC (rev 859) @@ -0,0 +1,87 @@ +package Everything::Node::Test::nodelet; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; + +use SUPER; +use Test::More; + +*Everything::Node::nodelet::SUPER = \&UNIVERSAL::SUPER; + +sub test_dbtables :Test( 2 ) +{ + my $self = shift; + my $module = $self->node_class(); + can_ok( $module, 'dbtables' ); + my @tables = $module->dbtables(); + is_deeply( \@tables, [qw( nodelet node )], + 'dbtables() should return node tables' ); +} + +sub test_insert :Test( 4 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->set_always( SUPER => 'super' ); + $db->set_series( getNode => { node_id => 1 }, undef ); + $node->{parent_container} = 8; + + is( $node->insert( 'user' ), 'super', + 'insert() should return result of SUPER() call' ); + + my ($method, $args) = $node->next_call(); + is( $args->[1], 'user', '... passing the user' ); + + is( $node->{parent_container}, 1, + '... setting node parent_container to GNC id if it exists' ); + + $node->insert( 'user' ); + is( $node->{parent_container}, 0, '... and to 0 if not' ); +} + +sub test_insert_access :Test( +0 ) +{ + my $self = shift; + my $db = $self->{mock_db}; + $db->set_false( -getNode ); + $self->SUPER(); +} + +sub test_insert_restrict_dupes :Test( +0 ) +{ + my $self = shift; + my $db = $self->{mock_db}; + $db->set_false( -getNode ); + $self->SUPER(); +} + +sub test_insert_restrictions :Test( +0 ) +{ + my $self = shift; + my $db = $self->{mock_db}; + $db->set_false( -getNode ); + $self->SUPER(); +} + +sub test_get_node_keys :Test( +2 ) +{ + my $self = shift; + my $node = $self->{node}; + + $self->SUPER(); + + $node->set_always( SUPER => { node_id => 10, nltext => 'nltext' } ); + + my $result = $node->getNodeKeys( 0 ); + is( $result->{nltext}, 'nltext', + 'getNodeKeys() should not remove nltext unlesss exporting' ); + + $result = $node->getNodeKeys( 1 ); + is( $result->{nltext}, undef, '... but should really remove it then' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/nodelet.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/nodelet.pm =================================================================== --- trunk/ebase/lib/Everything/Node/nodelet.pm 2006-05-12 22:14:57 UTC (rev 858) +++ trunk/ebase/lib/Everything/Node/nodelet.pm 2006-05-12 22:40:28 UTC (rev 859) @@ -35,20 +35,12 @@ { my ( $this, $USER ) = @_; - my $GNC = $$this{DB}->getNode( "general nodelet container", "container" ); + my $GNC = $this->{DB}->getNode( "general nodelet container", "container" ); # If this gets set to something inappropriate, we can have some # infinite container loops. - if ($GNC) - { - $$this{parent_container} = $$GNC{node_id}; - } - else - { - $$this{parent_container} = 0; - } - - $this->SUPER(); + $this->{parent_container} = $GNC ? $GNC->{node_id} : 0; + $this->SUPER( $USER ); } =head2 C<getNodeKeys> @@ -61,13 +53,10 @@ sub getNodeKeys { my ( $this, $forExport ) = @_; + my $keys = $this->SUPER($forExport); + delete $keys->{nltext} if $forExport; - if ($forExport) - { - delete $$keys{nltext}; - } - return $keys; } Modified: trunk/ebase/t/Node/nodelet.t =================================================================== --- trunk/ebase/t/Node/nodelet.t 2006-05-12 22:14:57 UTC (rev 858) +++ trunk/ebase/t/Node/nodelet.t 2006-05-12 22:40:28 UTC (rev 859) @@ -1,43 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use FakeNode; -use Test::More tests => 8; - -my $module = 'Everything::Node::nodelet'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::node' ), 'nodelet should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( nodelet node )], - 'dbtables() should return node tables' ); - -my $node = FakeNode->new(); -$node->{_subs} = { - SUPER => [ ( 1 .. 5 ) ], - getNode => [ { node_id => 1 }, undef ], -}; -$node->{DB} = $node; -$node->{parent_container} = 8; - -is( Everything::Node::nodelet::insert($node), - 1, 'insert() should call SUPER() at end' ); -is( - join( ' ', @{ shift @{ $node->{_calls} } } ), - 'getNode general nodelet container container', - '... should get general nodelet container, if possible' -); -is( $node->{parent_container}, 1, '... setting parent_container to gnc if so' ); - -Everything::Node::nodelet::insert($node); -is( $node->{parent_container}, 0, '... and to 0 if not' ); +use Everything::Node::Test::nodelet; +Everything::Node::Test::nodelet->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-15 21:43:48
|
Revision: 863 Author: chromatic Date: 2006-05-15 14:43:37 -0700 (Mon, 15 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=863&view=rev Log Message: ----------- r16715@windwheel: chromatic | 2006-05-15 14:43:25 -0700 Ported htmlpage tests to new style. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/htmlpage.pm trunk/ebase/t/Node/htmlpage.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/htmlpage.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16712 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16715 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-15 21:24:46 UTC (rev 862) +++ trunk/ebase/MANIFEST 2006-05-15 21:43:37 UTC (rev 863) @@ -90,6 +90,7 @@ lib/Everything/Node/Test/dbtable.pm lib/Everything/Node/Test/document.pm lib/Everything/Node/Test/htmlcode.pm +lib/Everything/Node/Test/htmlpage.pm lib/Everything/Node/Test/location.pm lib/Everything/Node/Test/mail.pm lib/Everything/Node/Test/node.pm Added: trunk/ebase/lib/Everything/Node/Test/htmlpage.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/htmlpage.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/htmlpage.pm 2006-05-15 21:43:37 UTC (rev 863) @@ -0,0 +1,85 @@ +package Everything::Node::Test::htmlpage; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; +use Test::More; + +use SUPER; +*Everything::Node::htmlpage::SUPER = \&UNIVERSAL::SUPER; + +sub test_dbtables +{ + my $self = shift; + my $class = $self->node_class(); + + can_ok( $class, 'dbtables' ); + + my @tables = $class->dbtables(); + is_deeply( \@tables, [qw( htmlpage node )], + 'dbtables() should return node tables' ); +} + +sub test_insert :Test( +5 ) +{ + my $self = shift; + my $node = $self->{node}; + my $db = $self->{mock_db}; + + $node->{parent_container} = 'npc'; + $self->SUPER(); + + $node->{DB} = $db; + delete $node->{parent_container}; + $node->set_true( 'SUPER' ); + $db->set_series( -getNode => undef, 'gnc' ); + + $node->insert( 'user' ); + is( $node->{parent_container}, 0, + 'insert() should set node parent container to 0 without it and a GNC' ); + + $node->insert( 'user' ); + is( $node->{parent_container}, 'gnc', + '... but should set it to GNC if that exists' ); + + $node->{parent_container} = 'npc'; + $node->insert( 'user' ); + is( $node->{parent_container}, 'npc', + '... but should not override an existing parent container' ); + + my ($method, $args) = $node->next_call(); + is( $method, 'SUPER', '... and should call SUPER()' ); + is( $args->[1], 'user', '... passing user' ); + + $node->clear(); +} + +sub test_insert_access :Test( +0 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->{parent_container} = 'npc'; + $self->SUPER(); +} + +sub test_insert_restrictions :Test( +0 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->{parent_container} = 'npc'; + $self->SUPER(); +} + +sub test_insert_restrict_dupes :Test( +0 ) +{ + my $self = shift; + my $node = $self->{node}; + + $node->{parent_container} = 'npc'; + $self->SUPER(); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/htmlpage.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/htmlpage.pm =================================================================== --- trunk/ebase/lib/Everything/Node/htmlpage.pm 2006-05-15 21:24:46 UTC (rev 862) +++ trunk/ebase/lib/Everything/Node/htmlpage.pm 2006-05-15 21:43:37 UTC (rev 863) @@ -36,14 +36,14 @@ my ( $this, $USER ) = @_; # If there is no parent container set, we need a default - unless ( $$this{parent_container} ) + unless ( $this->{parent_container} ) { my $GNC = - $$this{DB}->getNode( "general nodelet container", "container" ); - $$this{parent_container} = $GNC ? $GNC : 0; + $this->{DB}->getNode( "general nodelet container", "container" ); + $this->{parent_container} = $GNC ? $GNC : 0; } - $this->SUPER(); + $this->SUPER( $USER ); } 1; Modified: trunk/ebase/t/Node/htmlpage.t =================================================================== --- trunk/ebase/t/Node/htmlpage.t 2006-05-15 21:24:46 UTC (rev 862) +++ trunk/ebase/t/Node/htmlpage.t 2006-05-15 21:43:37 UTC (rev 863) @@ -1,52 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use FakeNode; -use Test::More tests => 9; - -my $module = 'Everything::Node::htmlpage'; -use_ok( $module ) or exit; -ok( $module->isa( 'Everything::Node::node' ), 'htmlpage should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( htmlpage node )], - 'dbtables() should return node tables' ); - -my $node = FakeNode->new(); - -$node->{_subs}{SUPER} = [ ( 1 .. 5 ) ]; -$node->{parent_container} = 1; - -ok( - Everything::Node::htmlpage::insert( $node, 'user' ), - 'insert() should call SUPER() when finished' -); - -$node->{parent_container} = 0; -$node->{DB} = $node; -$node->{_subs}{getNode} = [ undef, 'general' ]; -$node->{_calls} = []; - -ok( - Everything::Node::htmlpage::insert( $node, 'user2' ), - '... should work without a parent container' -); - -is( - join( ' ', @{ shift @{ $node->{_calls} } } ), - 'getNode general nodelet container container', - '... should look for general nodelet container lacking parent container' -); -is( $node->{parent_container}, 0, '... using 0 as parent if no gnc found' ); - -Everything::Node::htmlpage::insert($node); -is( $node->{parent_container}, 'general', '... using gnc, if found' ); +use Everything::Node::Test::htmlpage; +Everything::Node::Test::htmlpage->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <chr...@us...> - 2006-05-15 22:07:17
|
Revision: 865 Author: chromatic Date: 2006-05-15 15:07:05 -0700 (Mon, 15 May 2006) ViewCVS: http://svn.sourceforge.net/everydevel/?rev=865&view=rev Log Message: ----------- r16719@windwheel: chromatic | 2006-05-15 15:07:00 -0700 Ported image tests to new style. Modified Paths: -------------- trunk/ebase/MANIFEST trunk/ebase/lib/Everything/Node/image.pm trunk/ebase/t/Node/image.t Added Paths: ----------- trunk/ebase/lib/Everything/Node/Test/image.pm Property Changed: ---------------- trunk/ebase/ Property changes on: trunk/ebase ___________________________________________________________________ Name: svk:merge - a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16717 + a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:16719 Modified: trunk/ebase/MANIFEST =================================================================== --- trunk/ebase/MANIFEST 2006-05-15 22:02:43 UTC (rev 864) +++ trunk/ebase/MANIFEST 2006-05-15 22:07:05 UTC (rev 865) @@ -91,6 +91,7 @@ lib/Everything/Node/Test/document.pm lib/Everything/Node/Test/htmlcode.pm lib/Everything/Node/Test/htmlpage.pm +lib/Everything/Node/Test/image.pm lib/Everything/Node/Test/location.pm lib/Everything/Node/Test/mail.pm lib/Everything/Node/Test/node.pm Added: trunk/ebase/lib/Everything/Node/Test/image.pm =================================================================== --- trunk/ebase/lib/Everything/Node/Test/image.pm (rev 0) +++ trunk/ebase/lib/Everything/Node/Test/image.pm 2006-05-15 22:07:05 UTC (rev 865) @@ -0,0 +1,25 @@ +package Everything::Node::Test::image; + +use strict; +use warnings; + +use base 'Everything::Node::Test::node'; + +use Test::More; +use SUPER; + +*Everything::Node::image::SUPER = \&UNIVERSAL::SUPER; + +sub test_dbtables +{ + my $self = shift; + my $class = $self->node_class(); + + can_ok( $class, 'dbtables' ); + + my @tables = $class->dbtables(); + is_deeply( \@tables, [qw( image node )], + 'dbtables() should return node tables' ); +} + +1; Property changes on: trunk/ebase/lib/Everything/Node/Test/image.pm ___________________________________________________________________ Name: svn:mime-type + text/plain; charset=UTF-8 Name: svn:eol-style + native Modified: trunk/ebase/lib/Everything/Node/image.pm =================================================================== --- trunk/ebase/lib/Everything/Node/image.pm 2006-05-15 22:02:43 UTC (rev 864) +++ trunk/ebase/lib/Everything/Node/image.pm 2006-05-15 22:07:05 UTC (rev 865) @@ -22,7 +22,7 @@ sub dbtables { my $self = shift; - return 'image', $self->SUPER::dbtables(); + return 'image', $self->SUPER(); } 1; Modified: trunk/ebase/t/Node/image.t =================================================================== --- trunk/ebase/t/Node/image.t 2006-05-15 22:02:43 UTC (rev 864) +++ trunk/ebase/t/Node/image.t 2006-05-15 22:07:05 UTC (rev 865) @@ -1,22 +1,4 @@ -#!/usr/bin/perl +#! perl -use strict; -use warnings; - -BEGIN -{ - chdir 't' if -d 't'; - use lib 'lib'; -} - -use Test::More tests => 4; - -my $module = 'Everything::Node::image'; -use_ok( $module ) or exit; - -ok( $module->isa( 'Everything::Node::node' ), 'image should extend node' ); - -can_ok( $module, 'dbtables' ); -my @tables = $module->dbtables(); -is_deeply( \@tables, [qw( image node )], - 'dbtables() should return node tables' ); +use Everything::Node::Test::image; +Everything::Node::Test::image->runtests(); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X