Menu
▾
▴
everydevel-opers
|
From: <pau...@us...> - 2007-03-18 13:33:28
|
Revision: 943
http://svn.sourceforge.net/everydevel/?rev=943&view=rev
Author: paul_the_nomad
Date: 2007-03-16 17:28:24 -0700 (Fri, 16 Mar 2007)
Log Message:
-----------
FIX: Allow search on title name - bareword 'title' was used.
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
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:949
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:950
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Node/Test/node.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Test/node.pm 2007-03-17 00:28:00 UTC (rev 942)
+++ trunk/ebase/lib/Everything/Node/Test/node.pm 2007-03-17 00:28:24 UTC (rev 943)
@@ -189,7 +189,7 @@
'insert() should return node_id if it is positive already' );
}
-sub test_insert_restrict_dupes :Test( 2 )
+sub test_insert_restrict_dupes :Test( 4 )
{
my $self = shift;
my $node = $self->{node};
@@ -199,7 +199,7 @@
$node->{restrictdupes} = 1;
$node->set_true(qw( -hasAccess -restrictTitle -getId ))
->set_always( -getTableArray => [] );
- $db->set_series( -sqlSelect => 1, 0 )
+ $db->set_series( sqlSelect => 1, 0 )
->set_always( -getFields => 'none' )
->set_always( -now => '' )
->set_series( -getNode => undef, { DB => $db } )
@@ -209,6 +209,20 @@
is( $node->insert( '' ), 0,
'insert() should return 0 if dupes are restricted and exist' );
+ my ($method, $args) = $db->next_call;
+
+ is ($method, 'sqlSelect', '...checks to see whether there are dupes.');
+
+ is_deeply(
+ $args,
+ [
+ $db, 'count(*)',
+ 'node', 'title = ? AND type_nodetype = ?',
+ '', [ $node->{title}, 1 ]
+ ],
+ '...with the right title and id arguments.'
+ );
+
$node->{restrictdupes} = 0;
is( $node->insert( '' ), 100,
Modified: trunk/ebase/lib/Everything/Node/node.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/node.pm 2007-03-17 00:28:00 UTC (rev 942)
+++ trunk/ebase/lib/Everything/Node/node.pm 2007-03-17 00:28:24 UTC (rev 943)
@@ -72,7 +72,7 @@
my $DUPELIST =
$this->{DB}
->sqlSelect( 'count(*)', 'node', 'title = ? AND type_nodetype = ?',
- '', [ 'title', $id ] );
+ '', [ $this->{title}, $id ] );
# A node of this name already exists and restrict dupes is
# on for this nodetype. Don't do anything
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-03-18 13:33:43
|
Revision: 936
http://svn.sourceforge.net/everydevel/?rev=936&view=rev
Author: paul_the_nomad
Date: 2007-03-16 17:25:33 -0700 (Fri, 16 Mar 2007)
Log Message:
-----------
File to run XML/Node.t tests
Added Paths:
-----------
trunk/ebase/t/Everything/XML/
trunk/ebase/t/Everything/XML/Node.t
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:938
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:943
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Added: trunk/ebase/t/Everything/XML/Node.t
===================================================================
--- trunk/ebase/t/Everything/XML/Node.t (rev 0)
+++ trunk/ebase/t/Everything/XML/Node.t 2007-03-17 00:25:33 UTC (rev 936)
@@ -0,0 +1,4 @@
+#!/usr/bin/perl
+
+use Everything::XML::Test::Node;
+Everything::XML::Test::Node->runtests;
\ No newline at end of file
Property changes on: trunk/ebase/t/Everything/XML/Node.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-01 21:24:39
|
Revision: 945
http://svn.sourceforge.net/everydevel/?rev=945&view=rev
Author: paul_the_nomad
Date: 2007-05-01 14:24:38 -0700 (Tue, 01 May 2007)
Log Message:
-----------
FIX: Ensure relevent storage classes are loaded.
Modified Paths:
--------------
trunk/ebase/lib/Everything/NodeBase.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:960
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:961
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/NodeBase.pm
===================================================================
--- trunk/ebase/lib/Everything/NodeBase.pm 2007-05-01 21:24:05 UTC (rev 944)
+++ trunk/ebase/lib/Everything/NodeBase.pm 2007-05-01 21:24:38 UTC (rev 945)
@@ -85,6 +85,11 @@
$this->{staticNodetypes} = $staticNodetypes ? 1 : 0;
my $storage_class = 'Everything::DB::' . $storage;
+
+ ( my $file = $storage_class ) =~ s/::/\//g;
+ $file .= '.pm';
+ require $file;
+
$this->{storage} = $storage_class->new(
nb => $this,
cache => $this->{cache}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-01 21:25:06
|
Revision: 946
http://svn.sourceforge.net/everydevel/?rev=946&view=rev
Author: paul_the_nomad
Date: 2007-05-01 14:25:05 -0700 (Tue, 01 May 2007)
Log Message:
-----------
Utility sub to install nodetypes
Modified Paths:
--------------
trunk/ebase/lib/Everything/Storage/Nodeball.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:961
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:962
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Storage/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-05-01 21:24:38 UTC (rev 945)
+++ trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-05-01 21:25:05 UTC (rev 946)
@@ -492,6 +492,31 @@
}
+
+=head2 C<install_xml_nodetype_nodes>
+
+This is a method.
+
+It installs nodetype nodes stored as XML in the nodeballs.
+
+Returns undef.
+
+=cut
+
+sub install_xml_nodetype_nodes {
+
+ my ( $self ) = @_;
+
+ my $select_cb = sub { my $xmlnode = shift; return 1 if $xmlnode->get_nodetype eq 'nodetype'; return; };
+
+ $self->install_xml_nodes( $select_cb );
+
+ $self->get_nodebase->{cache}->flushCache();
+
+ $self->get_nodebase->rebuildNodetypeModules();
+
+}
+
=head2 C<install_nodeball>
Installs the nodeball. If supplied with an argument in a
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-01 21:25:38
|
Revision: 947
http://svn.sourceforge.net/everydevel/?rev=947&view=rev
Author: paul_the_nomad
Date: 2007-05-01 14:25:37 -0700 (Tue, 01 May 2007)
Log Message:
-----------
Command line utility subroutines and test
Added Paths:
-----------
trunk/ebase/lib/Everything/CmdLine.pm
trunk/ebase/lib/Everything/Test/CmdLine.pm
trunk/ebase/t/cmdline.t
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:962
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:963
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Added: trunk/ebase/lib/Everything/CmdLine.pm
===================================================================
--- trunk/ebase/lib/Everything/CmdLine.pm (rev 0)
+++ trunk/ebase/lib/Everything/CmdLine.pm 2007-05-01 21:25:37 UTC (rev 947)
@@ -0,0 +1,78 @@
+package Everything::CmdLine;
+
+use Getopt::Long;
+use Cwd;
+use Carp;
+use base 'Exporter';
+use strict;
+use warnings;
+
+our @EXPORT_OK = qw(get_options abs_path);
+
+Getopt::Long::Configure(qw/bundling/);
+
+sub get_options {
+ my ($usage_msg) = @_;
+ my %opts;
+ GetOptions(
+ \%opts, 'user|u=s', 'password|p=s', 'host|h=s',
+ 'database|d=s', 'port|P=s', 'type|t=s'
+ ) or usage_options($usage_msg);
+ return \%opts;
+
+}
+
+sub usage_options {
+ my ($usage_msg) = @_;
+ $usage_msg ||= "Usage:\n\n";
+
+ $usage_msg .= <<USAGE;
+Takes the following options:
+\t -d
+\t --database
+\t\t the db name. In the case of sqlite, it will be the file name of the test db, it will not be deleted on completion. If no name is specified a temporary file will be used if possible. The temporary file will be deleted on completion. In the case of mysql or postgresql, it is the name of the database to use.
+\t -u
+\t --user
+\t\tthe db user.
+\t -p
+\t --password
+\t\t the password for the db user.
+\t -t
+\t --type
+\t\t the db type (mysql|Pg|sqlite). Defaults to sqlite.
+\t -h
+\t --host
+\t\t the db host.
+\t -P
+\t --port
+\t\t the port number on which the db is listening.
+
+USAGE
+
+ warn $usage_msg;
+ exit 1;
+}
+
+=head2 C<abs_path>
+
+Get the absolute path of the file or directory.
+
+=cut
+
+sub abs_path {
+ my ($file) = @_;
+
+ #thank you Perl Cookbook!
+ $file =~ s{ ^ ~ ( [^/]* ) }
+ { $1
+ ? (getpwnam($1))[7]
+ : ( $ENV{HOME} || $ENV{LOGDIR}
+ || (getpwuid($>))[7]
+ )
+ }ex;
+
+ return Cwd::abs_path($file);
+
+}
+
+1;
Property changes on: trunk/ebase/lib/Everything/CmdLine.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/lib/Everything/Test/CmdLine.pm
===================================================================
--- trunk/ebase/lib/Everything/Test/CmdLine.pm (rev 0)
+++ trunk/ebase/lib/Everything/Test/CmdLine.pm 2007-05-01 21:25:37 UTC (rev 947)
@@ -0,0 +1,91 @@
+package Everything::Test::CmdLine;
+
+use Test::More;
+use Test::Warn;
+use Cwd;
+use warnings;
+use strict;
+
+use base 'Everything::Test::Abstract';
+
+my $exited;
+
+BEGIN {
+ *CORE::GLOBAL::exit = sub { $exited++ };
+}
+
+sub test_get_options : Test(4) {
+ my $self = shift;
+ my $test_code = \&{ $self->{class} . '::get_options' };
+
+ @ARGV = (
+ '-d', 'db', '-u', 'me', '-h', 'ahost',
+ '-p', 'password', '-P', '1111', '-t', 'atype'
+ );
+
+ my $opts = $test_code->();
+ is_deeply(
+ $opts,
+ {
+ database => 'db',
+ user => 'me',
+ host => 'ahost',
+ 'password' => 'password',
+ port => '1111',
+ type => 'atype'
+ },
+ '... checks all short command line options.'
+ );
+
+ @ARGV = (
+ '--database', 'db', '--user', 'me',
+ '--host', 'ahost', '--password', 'password',
+ '--port', '1111', '--type', 'atype'
+ );
+
+ $opts = $test_code->();
+ is_deeply(
+ $opts,
+ {
+ database => 'db',
+ user => 'me',
+ host => 'ahost',
+ 'password' => 'password',
+ port => '1111',
+ type => 'atype'
+ },
+ '... checks all long command line options.'
+ );
+
+ @ARGV = (
+ '--databaes', 'db', '--user', 'me',
+ '--host', 'ahost', '--password', 'password',
+ '--port', '1111', '--type', 'atype'
+ );
+
+ warnings_like { $opts = $test_code->() }[ qr/Unknown option/, qr/Usage/ ],
+ '... warns with incorrect options';
+ is( $exited, 1, '... and exits.' );
+
+}
+
+sub test_abs_path : Test(4) {
+ my $self = shift;
+ can_ok( $self->{class}, 'abs_path' ) || return 'abs_path not implemented.';
+ my $instance = $self->{instance};
+ my $test_code = \&{ $self->{class} . '::abs_path' };
+ my $rv = $test_code->('~/here');
+ is( $rv, $ENV{HOME} . '/here', '..gets absolute unix path.' );
+
+ my $wd = getcwd();
+ $rv = $test_code->('./here');
+ is( $rv, $wd . '/here', '..resolves the directory ".".' );
+
+ $wd =~ s/[\/][^\/]+$//;
+
+ $rv = $test_code->('../here');
+ is( $rv, $wd . '/here', '..resolves the directory "..".' );
+
+}
+
+1;
Property changes on: trunk/ebase/lib/Everything/Test/CmdLine.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/t/cmdline.t
===================================================================
--- trunk/ebase/t/cmdline.t (rev 0)
+++ trunk/ebase/t/cmdline.t 2007-05-01 21:25:37 UTC (rev 947)
@@ -0,0 +1,4 @@
+#! perl
+
+use Everything::Test::CmdLine;
+Everything::Test::CmdLine->runtests();
Property changes on: trunk/ebase/t/cmdline.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-01 21:26:12
|
Revision: 948
http://svn.sourceforge.net/everydevel/?rev=948&view=rev
Author: paul_the_nomad
Date: 2007-05-01 14:26:10 -0700 (Tue, 01 May 2007)
Log Message:
-----------
Added a raw xml attribute/accessor
Modified Paths:
--------------
trunk/ebase/lib/Everything/XML/Node.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:963
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:964
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/XML/Node.pm
===================================================================
--- trunk/ebase/lib/Everything/XML/Node.pm 2007-05-01 21:25:37 UTC (rev 947)
+++ trunk/ebase/lib/Everything/XML/Node.pm 2007-05-01 21:26:10 UTC (rev 948)
@@ -10,6 +10,11 @@
use Object::InsideOut;
+ my @raw_xml
+ :Field
+ :Standard(raw_xml)
+ :Arg(raw_xml);
+
my @title
:Field
:Standard(title)
@@ -409,6 +414,7 @@
ProtocolEncoding => 'ISO-8859-1'
);
+ $self->set_raw_xml( $xml );
my $doc = $XMLPARSER->parse("<everything>\n$xml\n</everything>");
my @nodes = $doc->getElementsByTagName("NODE");
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-01 22:41:33
|
Revision: 949
http://svn.sourceforge.net/everydevel/?rev=949&view=rev
Author: paul_the_nomad
Date: 2007-05-01 15:41:31 -0700 (Tue, 01 May 2007)
Log Message:
-----------
Ecore install tests
Added Paths:
-----------
trunk/ebase/t/ecore/
trunk/ebase/t/ecore/ecore-install.pl
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:964
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:974
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Added: trunk/ebase/t/ecore/ecore-install.pl
===================================================================
--- trunk/ebase/t/ecore/ecore-install.pl (rev 0)
+++ trunk/ebase/t/ecore/ecore-install.pl 2007-05-01 22:41:31 UTC (rev 949)
@@ -0,0 +1,717 @@
+#!/usr/bin/perl
+
+use Everything::NodeBase;
+use Everything::Nodeball;
+use Everything::CmdLine qw/get_options abs_path/;
+use File::Copy;
+use File::Spec;
+use Test::More;
+use DBI;
+use Carp qw/cluck confess croak/;
+use File::Temp qw/tempfile/;
+
+
+use strict;
+use warnings;
+$SIG{__DIE__} = \&confess;
+
+
+my $opts = get_options( usage() );
+my %opts = %$opts;
+
+my $ball = $ARGV[0];
+
+usage() unless $ball;
+
+my $tests = Everything::Test::Ecore->new;
+
+$tests->{nodeball} = abs_path( $ball );
+
+my %make_db = (
+ mysql => \&make_mysql_test_db,
+ Pg => \&make_Pg_test_db,
+ sqlite => \&make_sqlite_test_db,
+);
+
+my $db_type = $opts{type} || 'sqlite';
+my $test_db = $make_db{$db_type}->( \%opts );
+
+my $nb = Everything::NodeBase->new( $test_db, 1, $db_type );
+$tests->{nb} = $nb;
+$tests->{db_type} = $db_type;
+$tests->{base_test_db} = $test_db;
+
+$tests->runtests;
+
+my $tests_run = $tests->expected_tests;
+my $builder = $tests->builder;
+
+my @tests = $builder->summary;
+
+my @failed;
+foreach ( 0 .. $#tests ) {
+ push @failed, $_ unless $tests[$_];
+}
+
+print "\nNumber of Tests run: "
+ . scalar(@tests)
+ . " of $tests_run expected tests";
+
+if (@failed) {
+ print "\nList of failed tests: @failed";
+}
+else {
+ print "\nAll tests succesful.";
+}
+
+print "\n";
+
+exit;
+
+#### this sets up a clean sqlite database
+
+sub make_sqlite_test_db {
+ my $opts = shift;
+
+
+ my $tempdir = File::Temp::tempdir( CLEANUP => 1 );
+ my $test_db = $opts{database} || File::Spec->catfile( $tempdir, 'ecore_test.db' );
+ my $dbh = DBI->connect( "dbi:SQLite:dbname=$test_db", "", "" )
+ or die "No test database, $!";
+
+ foreach ( sqlite_base_tables() ) {
+ $dbh->do($_);
+ croak("$_, $DBI::errstr") if $DBI::errstr;
+ }
+
+ foreach ( mysql_base_nodes() ) {
+ $dbh->do($_);
+ croak("$_, $DBI::errstr") if $DBI::errstr;
+ }
+
+ return $test_db;
+}
+
+sub make_mysql_test_db {
+ my ($opts) = @_;
+ my $host = $$opts{host} || 'localhost';
+ my $user = $$opts{user} || $ENV{USER};
+ my $password = $$opts{password};
+ my $db_name = $$opts{database};
+ my $port = $$opts{Port} || 3306;
+
+ my $drh = DBI->install_driver('mysql');
+ my $rc =
+ $drh->func( 'createdb', $db_name, $host, $user, $password, 'admin' );
+ croak($DBI::errstr) if $DBI::errstr;
+
+ my $dbh = DBI->connect( "DBI:mysql:database=$db_name;host=$host;port=$port",
+ $user, $password );
+ croak($DBI::errstr) if $DBI::errstr;
+
+ foreach ( mysql_base_tables() ) {
+ $dbh->do($_);
+ croak($DBI::errstr) if $DBI::errstr;
+ }
+
+ foreach ( mysql_base_nodes() ) {
+ $dbh->do($_);
+ croak("$_, $DBI::errstr") if $DBI::errstr;
+ }
+
+ return join( ':', $db_name, $user, $password, $host );
+}
+
+sub make_Pg_test_db {
+ my ($opts) = @_;
+ my $host = $$opts{host} || 'localhost';
+ my $user = $$opts{user} || $ENV{USER};
+ my $password = $$opts{password};
+ my $db_name = $$opts{database};
+ my $port = $$opts{Port} || 5432;
+
+ my $dbh = DBI->connect( "DBI:Pg:dbname=$db_name;host=$host;port=$port",
+ $user, $password )
+ || croak(
+"$DBI::errstr, NB: you must create a Pg database before the tests can be run."
+ );
+
+ foreach ( Pg_base_tables() ) {
+ $dbh->do($_);
+ croak($DBI::errstr) if $DBI::errstr;
+ }
+
+ foreach ( Pg_base_nodes() ) {
+ $dbh->do($_);
+ croak("$_, $DBI::errstr") if $DBI::errstr;
+ }
+
+ ## ensure the node_id sequence is properly set
+ $dbh->do("SELECT setval('node_node_id_seq', 3)");
+
+ return join( ':', $db_name, $user, $password, $host );
+}
+
+sub usage {
+
+ "\nUsage:\n\t$0 [options] <path to nodeball>\n\n";
+
+}
+
+sub Pg_base_tables {
+ return (
+ q{CREATE TABLE "setting" (
+ "setting_id" serial NOT NULL,
+ "vars" text default '',
+ PRIMARY KEY ("setting_id")
+)},
+ q{CREATE TABLE "node" (
+ "node_id" serial UNIQUE NOT NULL,
+ "type_nodetype" bigint DEFAULT '0' NOT NULL,
+ "title" character(240) DEFAULT '' NOT NULL,
+ "author_user" bigint DEFAULT '0' NOT NULL,
+ "createtime" timestamp NOT NULL,
+ "modified" timestamp DEFAULT '-infinity' NOT NULL,
+ "hits" bigint DEFAULT '0',
+ "loc_location" bigint DEFAULT '0',
+ "reputation" bigint DEFAULT '0' NOT NULL,
+ "lockedby_user" bigint DEFAULT '0' NOT NULL,
+ "locktime" timestamp DEFAULT '-infinity' NOT NULL,
+ "authoraccess" character(4) DEFAULT 'iiii' NOT NULL,
+ "groupaccess" character(5) DEFAULT 'iiiii' NOT NULL,
+ "otheraccess" character(5) DEFAULT 'iiiii' NOT NULL,
+ "guestaccess" character(5) DEFAULT 'iiiii' NOT NULL,
+ "dynamicauthor_permission" bigint DEFAULT '-1' NOT NULL,
+ "dynamicgroup_permission" bigint DEFAULT '-1' NOT NULL,
+ "dynamicother_permission" bigint DEFAULT '-1' NOT NULL,
+ "dynamicguest_permission" bigint DEFAULT '-1' NOT NULL,
+ "group_usergroup" bigint DEFAULT '-1' NOT NULL,
+ PRIMARY KEY ("node_id")
+)},
+ q{CREATE INDEX "title" on node ("title", "type_nodetype")},
+ q{CREATE INDEX "author" on node ("author_user")},
+ q{CREATE INDEX "type" on node ("type_nodetype")},
+ q{CREATE TABLE "nodetype" (
+ "nodetype_id" serial NOT NULL,
+ "restrict_nodetype" bigint DEFAULT '0',
+ "extends_nodetype" bigint DEFAULT '0',
+ "restrictdupes" bigint DEFAULT '0',
+ "sqltable" character(255),
+ "grouptable" character(40) DEFAULT '',
+ "defaultauthoraccess" character(4) DEFAULT 'iiii' NOT NULL,
+ "defaultgroupaccess" character(5) DEFAULT 'iiiii' NOT NULL,
+ "defaultotheraccess" character(5) DEFAULT 'iiiii' NOT NULL,
+ "defaultguestaccess" character(5) DEFAULT 'iiiii' NOT NULL,
+ "defaultgroup_usergroup" bigint DEFAULT '-1' NOT NULL,
+ "defaultauthor_permission" bigint DEFAULT '-1' NOT NULL,
+ "defaultgroup_permission" bigint DEFAULT '-1' NOT NULL,
+ "defaultother_permission" bigint DEFAULT '-1' NOT NULL,
+ "defaultguest_permission" bigint DEFAULT '-1' NOT NULL,
+ "maxrevisions" bigint DEFAULT '-1' NOT NULL,
+ "canworkspace" bigint DEFAULT '-1' NOT NULL,
+ PRIMARY KEY ("nodetype_id")
+)},
+ q{CREATE TABLE version (
+ version_id INTEGER PRIMARY KEY DEFAULT '0' NOT NULL,
+ version INTEGER DEFAULT '1' NOT NULL
+)}
+ );
+}
+
+sub sqlite_base_tables {
+ return (
+ q{CREATE TABLE setting (
+ setting_id INTEGER PRIMARY KEY NOT NULL,
+ vars text DEFAULT ''
+)},
+ q{CREATE TABLE node (
+ node_id INTEGER PRIMARY KEY NOT NULL,
+ type_nodetype integer(20) NOT NULL DEFAULT '0',
+ title char(240) NOT NULL DEFAULT '',
+ author_user integer(20) NOT NULL DEFAULT '0',
+ createtime timestamp NOT NULL,
+ modified timestamp NOT NULL DEFAULT '0000-00-00',
+ hits integer(20) DEFAULT '0',
+ loc_location integer(20) DEFAULT '0',
+ reputation integer(20) NOT NULL DEFAULT '0',
+ lockedby_user integer(20) NOT NULL DEFAULT '0',
+ locktime timestamp NOT NULL DEFAULT '0',
+ authoraccess char(4) NOT NULL DEFAULT 'iiii',
+ groupaccess char(5) NOT NULL DEFAULT 'iiiii',
+ otheraccess char(5) NOT NULL DEFAULT 'iiiii',
+ guestaccess char(5) NOT NULL DEFAULT 'iiiii',
+ dynamicauthor_permission integer(20) NOT NULL DEFAULT '-1',
+ dynamicgroup_permission integer(20) NOT NULL DEFAULT '-1',
+ dynamicother_permission integer(20) NOT NULL DEFAULT '-1',
+ dynamicguest_permission integer(20) NOT NULL DEFAULT '-1',
+ group_usergroup integer(20) NOT NULL DEFAULT '-1'
+)},
+ q{CREATE TABLE nodetype (
+nodetype_id INTEGER PRIMARY KEY NOT NULL,
+restrict_nodetype integer(20) DEFAULT '0',
+extends_nodetype integer(20) DEFAULT '0',
+restrictdupes integer(20) DEFAULT '0',
+sqltable char(255),
+grouptable char(40) DEFAULT '',
+defaultauthoraccess char(4) NOT NULL DEFAULT 'iiii',
+defaultgroupaccess char(5) NOT NULL DEFAULT 'iiiii',
+defaultotheraccess char(5) NOT NULL DEFAULT 'iiiii',
+defaultguestaccess char(5) NOT NULL DEFAULT 'iiiii',
+defaultgroup_usergroup integer(20) NOT NULL DEFAULT '-1',
+defaultauthor_permission integer(20) NOT NULL DEFAULT '-1',
+defaultgroup_permission integer(20) NOT NULL DEFAULT '-1',
+defaultother_permission integer(20) NOT NULL DEFAULT '-1',
+defaultguest_permission integer(20) NOT NULL DEFAULT '-1',
+maxrevisions integer(20) NOT NULL DEFAULT '-1',
+canworkspace integer(20) NOT NULL DEFAULT '-1'
+)},
+ q{CREATE TABLE version (
+ version_id INTEGER PRIMARY KEY DEFAULT '0' NOT NULL,
+ version INTEGER DEFAULT '1' NOT NULL
+)}
+ );
+
+}
+
+sub mysql_base_tables {
+
+ return (
+ q{CREATE TABLE node (
+ node_id int(11) NOT NULL auto_increment,
+ type_nodetype int(11) DEFAULT '0' NOT NULL,
+ title char(240) DEFAULT '' NOT NULL,
+ author_user int(11) DEFAULT '0' NOT NULL,
+ createtime datetime DEFAULT '0000-00-00 00:00:00' NOT NULL,
+ modified datetime DEFAULT '0000-00-00 00:00:00' NOT NULL,
+ hits int(11) DEFAULT '0',
+ loc_location int(11) DEFAULT '0',
+ reputation int(11) DEFAULT '0' NOT NULL,
+ lockedby_user int(11) DEFAULT '0' NOT NULL,
+ locktime datetime DEFAULT '0000-00-00 00:00:00' NOT NULL,
+ authoraccess char(4) DEFAULT 'iiii' NOT NULL,
+ groupaccess char(5) DEFAULT 'iiiii' NOT NULL,
+ otheraccess char(5) DEFAULT 'iiiii' NOT NULL,
+ guestaccess char(5) DEFAULT 'iiiii' NOT NULL,
+ dynamicauthor_permission int(11) DEFAULT '-1' NOT NULL,
+ dynamicgroup_permission int(11) DEFAULT '-1' NOT NULL,
+ dynamicother_permission int(11) DEFAULT '-1' NOT NULL,
+ dynamicguest_permission int(11) DEFAULT '-1' NOT NULL,
+ group_usergroup int(11) DEFAULT '-1' NOT NULL,
+ PRIMARY KEY (node_id),
+ KEY title (title,type_nodetype),
+ KEY author (author_user),
+ KEY type (type_nodetype)
+)},
+ q{CREATE TABLE nodetype (
+ nodetype_id int(11) DEFAULT '0' NOT NULL,
+ restrict_nodetype int(11) DEFAULT '0',
+ extends_nodetype int(11) DEFAULT '0',
+ restrictdupes int(11) DEFAULT '0',
+ sqltable char(255),
+ grouptable char(40) DEFAULT '',
+ defaultauthoraccess char(4) DEFAULT 'iiii' NOT NULL,
+ defaultgroupaccess char(5) DEFAULT 'iiiii' NOT NULL,
+ defaultotheraccess char(5) DEFAULT 'iiiii' NOT NULL,
+ defaultguestaccess char(5) DEFAULT 'iiiii' NOT NULL,
+ defaultgroup_usergroup int(11) DEFAULT '-1' NOT NULL,
+ defaultauthor_permission int(11) DEFAULT '-1' NOT NULL,
+ defaultgroup_permission int(11) DEFAULT '-1' NOT NULL,
+ defaultother_permission int(11) DEFAULT '-1' NOT NULL,
+ defaultguest_permission int(11) DEFAULT '-1' NOT NULL,
+ maxrevisions int(11) DEFAULT '-1' NOT NULL,
+ canworkspace int(11) DEFAULT '-1' NOT NULL,
+ PRIMARY KEY (nodetype_id)
+)},
+ q{CREATE TABLE setting (
+ setting_id int(11) DEFAULT '0' NOT NULL,
+ vars text NOT NULL,
+ PRIMARY KEY (setting_id)
+)},
+ q{CREATE TABLE version (
+ version_id int(11) DEFAULT '0' NOT NULL,
+ version int(11) DEFAULT '1' NOT NULL,
+ PRIMARY KEY (version_id)
+)}
+ )
+
+}
+
+sub mysql_base_nodes {
+
+ return (
+q{INSERT INTO node VALUES (1,1,'nodetype',-1,'0000-00-00 00:00:00','0000-00-00 00:00:00',0,0,0,0,'0000-00-00 00:00:00','iiii','rwxdc','-----','-----',0,0,0,0,0)},
+q{INSERT INTO node VALUES (2,1,'node',-1,'0000-00-00 00:00:00','0000-00-00 00:00:00',0,0,0,0,'0000-00-00 00:00:00','rwxd','-----','-----','-----',-1,-1,-1,-1,0)},
+q{INSERT INTO node VALUES (3,1,'setting',-1,'0000-00-00 00:00:00','0000-00-00 00:00:00',0,0,0,0,'0000-00-00 00:00:00','rwxd','-----','-----','-----',0,0,0,0,0)},
+q{INSERT INTO nodetype VALUES (1,0,2,1,'nodetype','','rwxd','rwxdc','-----','-----',0,0,0,0,0,-1,0)},
+q{INSERT INTO nodetype VALUES (2,0,0,1,'','','rwxd','r----','-----','-----',0,0,0,0,0,1000,1)},
+q{INSERT INTO nodetype VALUES (3,0,2,1,'setting','','rwxd','-----','-----','-----',0,0,0,0,0,-1,-1)},
+
+ )
+
+}
+
+sub Pg_base_nodes {
+
+ return (
+q{INSERT INTO node VALUES (1,1,'nodetype',-1,'-infinity','-infinity',0,0,0,0, '-infinity','iiii','rwxdc','-----','-----',0,0,0,0,0)},
+q{INSERT INTO node VALUES (2,1,'node',-1,'-infinity','-infinity',0,0,0,0,'-infinity','rwxd','-----','-----','-----',-1,-1,-1,-1,0)},
+q{INSERT INTO node VALUES (3,1,'setting',-1,'-infinity','-infinity',0,0,0,0,'-infinity','rwxd','-----','-----','-----',0,0,0,0,0)},
+q{INSERT INTO nodetype VALUES (1,0,2,1,'nodetype','','rwxd','rwxdc','-----','-----',0,0,0,0,0,-1,0)},
+q{INSERT INTO nodetype VALUES (2,0,0,1,'','','rwxd','r----','-----','-----',0,0,0,0,0,1000,1)},
+q{INSERT INTO nodetype VALUES (3,0,2,1,'setting','','rwxd','-----','-----','-----',0,0,0,0,0,-1,-1)},
+
+ )
+
+}
+
+package Everything::Test::Ecore;
+
+use Everything::NodeBase;
+use Everything::Storage::Nodeball;
+use Carp qw/confess cluck croak/;
+use Test::More;
+use base 'Test::Class';
+
+use strict;
+use warnings;
+
+sub startup : Test( startup ) {
+ my $self = shift;
+ my $stored_ball = Everything::Storage::Nodeball->new;
+ $stored_ball->set_nodebase( $self->{nb} );
+ $stored_ball->set_nodeball( $self->{nodeball} );
+
+ $self->{ball} = $stored_ball;
+
+ # $self->install_basenodes; # base nodes always in test db
+}
+
+sub test_10_sql_tables : Test(1) {
+ my $self = shift;
+
+ my %expected_tables =
+ map { $_ => 1 }
+ qw/version mail image container node symlink nodemethod nodetype typeversion nodelet revision workspace htmlcode themesetting htmlpage nodegroup javascript setting document user links/;
+
+ $self->{ball}->insert_sql_tables;
+ my %actual_tables = map { $_ => 1 } $self->{nb}->{storage}->list_tables;
+
+ is_deeply( \%actual_tables, \%expected_tables,
+ '...testing all tables we expected are there.' )
+ || $self->BAILOUT("Can't proceed without tables installed");
+
+}
+
+sub test_11_base_nodes : Test(3) {
+
+ my $self = shift;
+
+ my $nb = $self->{nb};
+
+ my $ball = $self->{ball};
+ my $nodes = $nb->getNodeWhere( '', 'nodetype', 'node_id' );
+
+ my @get_these = ();
+ push @get_these, [ $$_{title}, $$_{type}{title} ] foreach @$nodes;
+
+ my $select = sub {
+ my $xmlnode = shift;
+ my $nodetype = $xmlnode->get_nodetype;
+ my $title = $xmlnode->get_title;
+ foreach (@get_these) {
+ if ( $title eq $_->[0] && $nodetype eq $_->[1] ) {
+ return 1;
+ }
+ }
+
+ return;
+ };
+ my $node_iterator = $ball->make_node_iterator($select);
+
+ while ( my $xmlnode = $node_iterator->() ) {
+ my $title = $xmlnode->get_title;
+ my $type = $xmlnode->get_nodetype;
+
+ my $node = $nb->getNode( $title, $type );
+
+ foreach ( @{ $xmlnode->get_attributes } ) {
+
+ if ( $_->get_type eq 'literal_value' ) {
+ $$node{ $_->get_name } = $_->get_content;
+ }
+ elsif ( $_->get_type eq 'noderef' ) {
+
+ my ($ref_name) = split /,/, $_->get_type_nodetype;
+ my $ref_node = $nb->getNode( $_->get_content, $ref_name );
+
+ $$node{ $_->get_name } = $ref_node ? $ref_node->{node_id} : -1;
+ }
+ }
+
+ ok( $node->update( -1, 'nomodify' ),
+ "...base node, $$node{title}, has been updated" );
+ }
+ $nb->rebuildNodetypeModules();
+
+}
+
+sub test_20_nodetypes : Test(1) {
+
+ my $self = shift;
+
+ my $nb = $self->{nb};
+ my $nodetypes_dir = $self->{ball}->get_nodeball_dir . '/nodes/nodetype';
+
+ $Everything::DB = $nb;
+ my $errors;
+ local *Everything::logErrors;
+ *Everything::logErrors = sub { $errors = "@_"; };
+
+ $self->{ball}->install_xml_nodetype_nodes;
+ print "Fixing references...\n";
+ $self->{ball}->fix_node_references(1);
+ print " - Done.\n";
+
+
+ my %all_types =
+ map { $_ => 1 } $self->{nb}->{storage}->fetch_all_nodetype_names;
+
+ my %xml_types = ();
+ my $iterator = $self->{ball}->make_node_iterator(
+ sub {
+ my $xmlnode = shift;
+ if ( $xmlnode->get_nodetype eq 'nodetype' ) {
+ $xml_types{ $xmlnode->get_title } = 1;
+ return 1;
+ }
+ return;
+ }
+ );
+ while ( $iterator->() ) {
+ }
+ is_deeply( \%all_types, \%xml_types, '...28 nodetypes are installed.' );
+
+}
+
+sub test_30_install_nodes : Test(1) {
+
+ my $self = shift;
+ my $errors = '';
+
+ local *Everything::logErrors;
+ *Everything::logErrors = sub { confess("@_") };
+
+ $self->{ball}->install_xml_nodes(
+ sub {
+ my $xmlnode = shift;
+ return 1 unless $xmlnode->get_nodetype eq 'nodetype';
+ return;
+ }
+ );
+
+ $self->{ball}->fix_node_references(1);
+ my $nodes = $self->{nb}->selectNodeWhere();
+
+ is( @$nodes, 273, '...should be 273 nodes installed.' );
+}
+
+sub test_40_verify_nodes : Test( 273 ) {
+ my $self = shift;
+ my $nb = $self->{nb};
+
+ $nb->resetNodeCache();
+
+ my $ball = $self->{ball};
+ my $node_iterator = $ball->make_node_iterator;
+
+ while ( my $xmlnode = $node_iterator->() ) {
+ my $title = $xmlnode->get_title;
+ my $type = $xmlnode->get_nodetype;
+
+ my $node = $nb->getNode( $title, $type );
+
+ ok( $node, "...test existence of '$title', '$type'" );
+
+ }
+
+}
+
+sub test_50_verify_nodes_attributes : Tests {
+ my $self = shift;
+ my $nb = $self->{nb};
+
+ my $ball = $self->{ball};
+ my $node_iterator = $ball->make_node_iterator;
+
+ my $total_tests = 0;
+ while ( my $xmlnode = $node_iterator->() ) {
+ my $atts = $xmlnode->get_attributes;
+ $total_tests += scalar(@$atts);
+
+ }
+
+ $self->num_tests($total_tests);
+
+ ## now run attribute tests
+ $node_iterator = $ball->make_node_iterator;
+
+ while ( my $xmlnode = $node_iterator->() ) {
+ my $atts = $xmlnode->get_attributes;
+
+ my $node_title = $xmlnode->get_title;
+ my $node_type = $xmlnode->get_nodetype;
+
+ my $node = $nb->getNode( $node_title, $node_type );
+
+ foreach (@$atts) {
+ my $att_name = $_->get_name;
+
+ my $att_type = $_->get_type;
+
+ if ( $att_type eq 'literal_value' ) {
+
+ ## the line below makes undef an empty string to deal
+ ## with the way database tables are created at the
+ ## moment.
+ my $content = defined $_->get_content ? $_->get_content : '';
+
+ is( $node->{$att_name}, $content,
+"...test node: '$node_title' of type '$node_type', attribute '$att_name'."
+ );
+ }
+ else {
+
+ my ($type_name) = split /,/, $_->get_type_nodetype;
+ my $node_name = $_->get_content;
+
+ my $wanted = $nb->getNode( $node_name, $type_name );
+
+ is( $node->{$att_name}, $wanted->{node_id},
+"... node '$node_title', attribute '$att_name' references '$$wanted{title}'."
+ );
+
+ }
+
+ }
+
+ }
+
+}
+
+sub test_60_verify_node_vars : Tests {
+ my $self = shift;
+ my $nb = $self->{nb};
+
+ my $ball = $self->{ball};
+
+ my $vars_selector = sub { return 1 if @{ $_[0]->get_vars }; return; };
+
+ my $node_iterator = $ball->make_node_iterator($vars_selector);
+
+ my $total_vars = 0;
+ while ( my $xmlnode = $node_iterator->() ) {
+ my $vars = $xmlnode->get_vars;
+ $total_vars += scalar(@$vars);
+
+ }
+
+ $self->num_tests($total_vars);
+
+ ## now run attribute tests
+ $node_iterator = $ball->make_node_iterator($vars_selector);
+
+ while ( my $xmlnode = $node_iterator->() ) {
+ my $vars = $xmlnode->get_vars;
+
+ my $node_title = $xmlnode->get_title;
+ my $node_type = $xmlnode->get_nodetype;
+
+ my $node = $nb->getNode( $node_title, $node_type );
+ my $db_vars = $node->getVars;
+
+ foreach (@$vars) {
+ my $var_name = $_->get_name;
+
+ my $var_type = $_->get_type;
+
+ if ( $var_type eq 'literal_value' ) {
+
+ ## the line below makes undef an empty string to deal
+ ## with the way database tables are created at the
+ ## moment.
+ my $content = defined $_->get_content ? $_->get_content : '';
+
+ is( $db_vars->{$var_name}, $content,
+"...test node: '$node_title' of type '$node_type', var '$var_name'."
+ );
+ }
+ else {
+
+ my ($type_name) = split /,/, $_->get_type_nodetype;
+ my $node_name = $_->get_content;
+
+ my $wanted = $nb->getNode( $node_name, $type_name );
+
+ is( $db_vars->{$var_name}, $wanted->{node_id},
+"... node '$node_title', var '$var_name' references '$$wanted{title}'."
+ );
+
+ }
+
+ }
+
+ }
+
+}
+
+sub test_70_verify_nodegroup_members : Tests {
+ my $self = shift;
+ my $nb = $self->{nb};
+
+ my $ball = $self->{ball};
+
+ my $group_selector =
+ sub { return 1 if @{ $_[0]->get_group_members }; return; };
+
+ my $node_iterator = $ball->make_node_iterator($group_selector);
+
+ my $total_members = 0;
+ while ( my $xmlnode = $node_iterator->() ) {
+ my $members = $xmlnode->get_group_members;
+ $total_members += scalar(@$members);
+
+ }
+
+ $self->num_tests($total_members);
+
+ ## now run attribute tests
+ $node_iterator = $ball->make_node_iterator($group_selector);
+
+ while ( my $xmlnode = $node_iterator->() ) {
+ my $members = $xmlnode->get_group_members;
+
+ my $node_title = $xmlnode->get_title;
+ my $node_type = $xmlnode->get_nodetype;
+
+ my $node = $nb->getNode( $node_title, $node_type );
+ my %db_members = map { $_ => 1 } @{ $node->selectGroupArray };
+
+ foreach (@$members) {
+
+ my ($type_name) = split /,/, $_->get_type_nodetype;
+ my $node_name = $_->get_name;
+
+ my $wanted = $nb->getNode( $node_name, $type_name );
+
+ ok(
+ $db_members{ $wanted->{node_id} },
+ "... node '$node_title',contains group member '$$wanted{title}."
+ );
+
+ }
+
+ }
+
+}
+
+1;
Property changes on: trunk/ebase/t/ecore/ecore-install.pl
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-02 07:17:18
|
Revision: 951
http://svn.sourceforge.net/everydevel/?rev=951&view=rev
Author: paul_the_nomad
Date: 2007-05-02 00:17:12 -0700 (Wed, 02 May 2007)
Log Message:
-----------
FIX: File::Find doesn't process files in predictable order
Modified Paths:
--------------
trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
trunk/ebase/lib/Everything/Test/Nodeball.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:974
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:979
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-05-01 23:03:58 UTC (rev 950)
+++ trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-05-02 07:17:12 UTC (rev 951)
@@ -377,10 +377,10 @@
close $fh;
}
- my @copy_args;
+ my %copy_args;
no strict 'refs';
local *{ $self->{class} . '::copy' };
- *{ $self->{class} . '::copy' } = sub { my @c = @_; push @copy_args, \@c };
+ *{ $self->{class} . '::copy' } = sub { $copy_args{ $_[0] } = $_[1] };
local *{ $self->{class} . '::getPMDir' };
*{ $self->{class} . '::getPMDir' } = sub { 'pm_dir' };
@@ -389,14 +389,14 @@
$test_code->($tempdir);
- is_deeply(
- $copy_args[0],
- [ "$tempdir/Everything/one.pm", 'pm_dir/Everything/one.pm' ],
+ is (
+ $copy_args{ "$tempdir/Everything/one.pm" },
+ 'pm_dir/Everything/one.pm',
'..copy first test file.'
);
- is_deeply(
- $copy_args[1],
- [ "$tempdir/Everything/two.pm", 'pm_dir/Everything/two.pm' ],
+ is (
+ $copy_args{ "$tempdir/Everything/two.pm" },
+ 'pm_dir/Everything/two.pm',
'..copy second test file.'
);
}
Modified: trunk/ebase/lib/Everything/Test/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Test/Nodeball.pm 2007-05-01 23:03:58 UTC (rev 950)
+++ trunk/ebase/lib/Everything/Test/Nodeball.pm 2007-05-02 07:17:12 UTC (rev 951)
@@ -141,7 +141,7 @@
}
-sub test_add_tables_to_dB : Test(6) {
+sub test_add_tables_to_db : Test(6) {
my $self = shift;
can_ok( $self->{class}, 'addTablesToDB' )
|| return 'addTablesToDB not implemented.';
@@ -155,7 +155,7 @@
close $fh;
}
- my @sub_args = ();
+ my %sub_args = ();
{
no strict 'refs';
@@ -163,25 +163,25 @@
use subs 'system';
*{ $self->{class} . '::system' } =
- sub { my @c = @_; push @sub_args, \@c };
+ sub { $sub_args{ $_[0] } = 1 };
use strict 'refs';
}
my @rv = $test_code->( 'test', $tempdir );
- is_deeply( \@rv, \@files, '...returns the processed files' );
- is_deeply(
- $sub_args[0]->[0],
- "mysql -u test<$tempdir/one.sql",
+ is_deeply( { map { $_ => 1} @rv } ,{ map { $_ => 1} @files }, '...returns the processed files' );
+ is (
+ $sub_args{"mysql -u test<$tempdir/one.sql"},
+ 1,
'...processing the sql files.'
);
- is_deeply(
- $sub_args[1]->[0],
- "mysql -u test<$tempdir/two.sql",
+ is (
+ $sub_args{"mysql -u test<$tempdir/two.sql"},
+ 1,
'...processing the sql files.'
);
- is_deeply(
- $sub_args[2]->[0],
- "mysql -u test<$tempdir/three.sql",
+ is (
+ $sub_args{"mysql -u test<$tempdir/three.sql"},
+ 1,
'...processing the sql files.'
);
@@ -708,7 +708,7 @@
close $fh;
}
- my @xmlfile2node_args = ();
+ my %xmlfile2node_args = ();
no strict 'refs';
local *{ $self->{class} . '::getTablesHashref' };
*{ $self->{class} . '::getTablesHashref' } = sub { { 'three' => 1 } };
@@ -718,7 +718,7 @@
local *{ $self->{class} . '::xmlfile2node' };
*{ $self->{class} . '::xmlfile2node' } =
- sub { push @xmlfile2node_args, $_[0] };
+ sub { $xmlfile2node_args{ $_[0] } = 1 };
local *{ $self->{class} . '::fixNodes' };
*{ $self->{class} . '::fixNodes' } = sub { 1 };
@@ -735,37 +735,37 @@
$mock->{cache} = $mock;
$mock->set_true(qw/flushCache rebuildNodetypeModules/);
- my @system_arg = ();
+ my %system_arg = ();
{
package Everything::Nodeball;
no warnings 'redefine';
use subs 'system';
- *system = sub { push @system_arg, $_[0]; };
+ *system = sub { $system_arg{$_[0]} = 1 };
local *STDOUT; #stop this being so noisy.
$test_code->($tempdir);
}
is(
- $system_arg[0],
- "mysql fictionaldb < $tables_dir/one.sql",
- '...check sql being processed.'
+ $system_arg{"mysql fictionaldb < $tables_dir/one.sql"},
+ 1,
+ '...check sql being processed.'
);
is(
- $system_arg[1],
- "mysql fictionaldb < $tables_dir/two.sql",
+ $system_arg{"mysql fictionaldb < $tables_dir/two.sql"},
+ 1,
'...check sql being processed.'
);
- is( $system_arg[2], undef, '...but misses already included table.' );
+ is( scalar( keys %system_arg ), 2, '...but misses already included table.' );
- is( $xmlfile2node_args[0], "$typesdir/firsttype.xml",
+ is( $xmlfile2node_args{"$typesdir/firsttype.xml"}, 1,
'...first type file.' );
- is( $xmlfile2node_args[1], "$typesdir/secondtype.xml",
+ is( $xmlfile2node_args{"$typesdir/secondtype.xml"}, 1,
'...second type file.' );
- is( $xmlfile2node_args[2], "$tempdir/firstnode.xml",
+ is( $xmlfile2node_args{"$tempdir/firstnode.xml"}, 1,
'...first node file.' );
- is( $xmlfile2node_args[3], "$tempdir/secondnode.xml",
+ is( $xmlfile2node_args{"$tempdir/secondnode.xml"}, 1,
'...second node file.' );
rmtree $tempdir;
}
@@ -788,10 +788,10 @@
close $fh;
}
- my @copy_args;
+ my %copy_args;
no strict 'refs';
local *{ $self->{class} . '::copy' };
- *{ $self->{class} . '::copy' } = sub { my @c = @_; push @copy_args, \@c };
+ *{ $self->{class} . '::copy' } = sub { $copy_args{$_[0]} = $_[1] };
local *{ $self->{class} . '::getPMDir' };
*{ $self->{class} . '::getPMDir' } = sub { 'pm_dir' };
@@ -801,14 +801,14 @@
local *STDOUT; # stop the noise;
$test_code->($tempdir);
}
- is_deeply(
- $copy_args[0],
- [ "$tempdir/Everything/one.pm", 'pm_dir/Everything/one.pm' ],
+ is (
+ $copy_args{"$tempdir/Everything/one.pm"},
+ 'pm_dir/Everything/one.pm',
'..copy first test file.'
);
- is_deeply(
- $copy_args[1],
- [ "$tempdir/Everything/two.pm", 'pm_dir/Everything/two.pm' ],
+ is (
+ $copy_args{"$tempdir/Everything/two.pm"},
+ 'pm_dir/Everything/two.pm',
'..copy second test file.'
);
}
@@ -959,7 +959,7 @@
close $fh;
}
- my @xmlfile2node_args = ();
+ my %xmlfile2node_args = ();
my $confirmyn_args;
no strict 'refs';
@@ -979,7 +979,7 @@
my @xmlfile_returns = ( [111], [222] );
*{ $self->{class} . '::xmlfile2node' } =
- sub { push @xmlfile2node_args, $_[0]; return shift @xmlfile_returns };
+ sub { $xmlfile2node_args{$_[0]} = 1; return shift @xmlfile_returns };
local *{ $self->{class} . '::checkTables' };
*{ $self->{class} . '::checkTables' } = sub { 1 };
@@ -1012,18 +1012,16 @@
$test_code->( $mock, $mock, $tempdir );
}
- is( $xmlfile2node_args[2], "$typesdir/firsttype.xml",
+ is( $xmlfile2node_args{"$typesdir/firsttype.xml"}, 1,
'...first type file.' );
- is( $xmlfile2node_args[3], "$typesdir/secondtype.xml",
+ is( $xmlfile2node_args{"$typesdir/secondtype.xml"}, 1,
'...second type file.' );
is(
- $xmlfile2node_args[0],
- "$tempdir/nodes/firstnode.xml",
+ $xmlfile2node_args{"$tempdir/nodes/firstnode.xml"}, 1,
'...first node file.'
);
is(
- $xmlfile2node_args[1],
- "$tempdir/nodes/secondnode.xml",
+ $xmlfile2node_args{"$tempdir/nodes/secondnode.xml"}, 1,
'...second node file.'
);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:11:09
|
Revision: 955
http://svn.sourceforge.net/everydevel/?rev=955&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:11:06 -0700 (Tue, 22 May 2007)
Log Message:
-----------
FIX: call to correct sql function to fetch current date and fix in EveryAuth to
make it DB neutral.
Modified Paths:
--------------
trunk/ebase/lib/Everything/Auth/EveryAuth.pm
trunk/ebase/lib/Everything/DB/Test/sqlite.pm
trunk/ebase/lib/Everything/DB/sqlite.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:979
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:981
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Auth/EveryAuth.pm
===================================================================
--- trunk/ebase/lib/Everything/Auth/EveryAuth.pm 2007-05-22 23:10:00 UTC (rev 954)
+++ trunk/ebase/lib/Everything/Auth/EveryAuth.pm 2007-05-22 23:11:06 UTC (rev 955)
@@ -163,7 +163,7 @@
if ( $genCrypt eq $crpasswd )
{
- $$user{lasttime} = $DB->sqlSelect("NOW()");
+ $$user{lasttime} = $DB->sqlSelect( $DB->now );
return $user;
}
Modified: trunk/ebase/lib/Everything/DB/Test/sqlite.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/Test/sqlite.pm 2007-05-22 23:10:00 UTC (rev 954)
+++ trunk/ebase/lib/Everything/DB/Test/sqlite.pm 2007-05-22 23:11:06 UTC (rev 955)
@@ -407,7 +407,7 @@
sub test_now : Test(2) {
my $self = shift;
can_ok( $self->{class}, 'now' ) || return;
- ok( $self->{instance}->now, '... returns seconds since the epoch.' );
+ is( $self->{instance}->now, "datetime('now')", '... calls sqlite datetime function.' );
}
sub test_timediff : Test(2) {
Modified: trunk/ebase/lib/Everything/DB/sqlite.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/sqlite.pm 2007-05-22 23:10:00 UTC (rev 954)
+++ trunk/ebase/lib/Everything/DB/sqlite.pm 2007-05-22 23:11:06 UTC (rev 955)
@@ -390,7 +390,7 @@
return @tables;
}
-sub now { return time() }
+sub now { return "datetime('now')" }
sub timediff { "$_[1] - $_[2]" }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:11:47
|
Revision: 956
http://svn.sourceforge.net/everydevel/?rev=956&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:11:44 -0700 (Tue, 22 May 2007)
Log Message:
-----------
Methods to return create table statements and associated tests
Modified Paths:
--------------
trunk/ebase/lib/Everything/DB/Pg.pm
trunk/ebase/lib/Everything/DB/Test/Pg.pm
trunk/ebase/lib/Everything/DB/Test/mysql.pm
trunk/ebase/lib/Everything/DB/Test/sqlite.pm
trunk/ebase/lib/Everything/DB/mysql.pm
trunk/ebase/lib/Everything/DB/sqlite.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:981
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:982
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/DB/Pg.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/Pg.pm 2007-05-22 23:11:06 UTC (rev 955)
+++ trunk/ebase/lib/Everything/DB/Pg.pm 2007-05-22 23:11:44 UTC (rev 956)
@@ -429,4 +429,187 @@
}
+
+=head2 C<get_create_table>
+
+Returns the create table statements of the tables whose names were passed as arguments
+
+Returns a list if there is more than one table or a string if there is only one.
+
+=cut
+
+### Here we build the create statement manually. It should be OK with
+### the the current everything. However, it doesn't work if we start
+### using other features, such as foreign key constraints.
+
+## The code below has been copied from some php code found here
+## http://www.phpbbstyles.com/viewtopic.php?p=69590&highlight= That
+## code is a bit broken as it uses pg_relcheck, which is not current.
+## CHECK constraints are now handled by pg_constraint. Which is what
+## we'd use if we were going to beef up this method.
+
+sub get_create_table {
+
+ my ( $self, @tables ) = @_;
+
+ @tables = $self->list_tables unless @tables;
+ my %table_def;
+ my $dbh = $self->{dbh};
+
+ foreach (@tables) {
+
+ my $column_def = '';
+ ## First get columns:
+
+ my $sth = $dbh->prepare(
+'SELECT a.attnum, a.attname AS field, t.typname as type, a.attlen AS length, a.atttypmod as lengthvar, a.attnotnull as notnull
+ FROM pg_type t, pg_class c,
+ pg_attribute a
+
+ WHERE c.relname = ?
+ AND a.attnum > 0
+ AND a.attrelid = c.oid
+ AND a.atttypid = t.oid
+ ORDER BY a.attnum'
+ ) || die $DBI::errstr;
+ $sth->execute($_) || die $DBI::errstr;
+
+ my @col_def;
+ while ( my $result = $sth->fetchrow_hashref ) {
+
+ push @col_def,
+ {
+ field => $$result{'field'},
+ data_type => $$result{'type'},
+ notnull => $$result{'notnull'},
+ length => $$result{'length'},
+ lengthvar => $$result{'lengthvar'},
+ attnum => $$result{attnum}
+ };
+
+ }
+ $table_def{$_} = \@col_def;
+
+ }
+
+ ### Now get default values someone who is better at SQL than I
+ ### could do this in one statement with a proper use of LEFT JOIN
+ ### or UNION or something clever
+
+ my $sth = $dbh->prepare(
+ "SELECT d.adsrc AS rowdefault
+ FROM pg_attrdef d, pg_class c
+ WHERE (c.relname = ? )
+ AND (c.oid = d.adrelid)
+ AND d.adnum = ? "
+ ) || die $DBI::errstr;
+
+ foreach my $table_name ( keys %table_def ) {
+ foreach my $column ( @{ $table_def{$table_name} } ) {
+
+ $sth->execute( $table_name, $column->{attnum} ) || die $DBI::errstr;
+
+ while ( my $result = $sth->fetchrow_arrayref ) {
+ $column->{default} = $$result[0];
+ }
+
+ }
+
+ }
+
+ my @statements;
+ foreach my $table_name ( keys %table_def ) {
+ my $statement = "CREATE TABLE \"$table_name\" (\n";
+
+ my @col_defs;
+ foreach my $col ( @{ $table_def{$table_name} } ) {
+
+ my $col_name = $col->{field};
+ my $data_type = $col->{'data_type'};
+ my $data_len = $col->{'length'};
+ my $default = $col->{'default'};
+ my $lengthvar = $col->{'lengthvar'};
+
+ if ( $data_type eq 'bpchar' ) {
+ $data_type = 'char(' . ( $lengthvar - 4 ) . ')';
+ }
+
+ if ( $data_type eq 'int8' ) {
+ $data_type = 'bigint';
+ }
+
+ if ( $data_type eq 'int4' ) {
+ $data_type = 'integer';
+ }
+
+ if ( $default && $default =~ /nextval/ ) {
+ undef $default;
+ $data_type = 'serial';
+ }
+
+ $default =~ s/::(.*)$// if $default;
+
+ my $statement = "\t\"$col_name\" $data_type";
+ $statement .= " DEFAULT $default" if $default;
+ $statement .= ' NOT NULL' if $col->{'notnull'};
+ push @col_defs, $statement;
+ }
+
+ ## find keys
+
+ my $sth = $dbh->prepare(
+"SELECT ic.relname AS index_name, bc.relname AS tab_name, ta.attname AS column_name, i.indisunique AS unique_key, i.indisprimary AS primary_key
+ FROM pg_class bc, pg_class ic, pg_index i, pg_attribute ta, pg_attribute ia
+ WHERE (bc.oid = i.indrelid)
+ AND (ic.oid = i.indexrelid)
+ AND (ia.attrelid = i.indexrelid)
+ AND (ta.attrelid = bc.oid)
+ AND (bc.relname = ?)
+ AND (ta.attrelid = i.indrelid)
+ AND (ta.attnum = i.indkey[ia.attnum-1])
+ ORDER BY index_name, tab_name, column_name"
+ ) || die $DBI::errstr;
+
+ $sth->execute($table_name);
+
+ my %indices;
+ while ( my $result = $sth->fetchrow_hashref ) {
+
+ if ( $result->{primary_key} ) {
+ push @col_defs, "\tPRIMARY KEY (\"$$result{column_name}\")";
+ }
+ else {
+ if ( exists $indices{ $$result{index_name} } ) {
+ push @{ $indices{ $$result{index_name} }->{column_name} },
+ $$result{column_name};
+ }
+ else {
+ $indices{ $$result{index_name} } = {
+ unique => $$result{unique_key} ? ' UNIQUE' : '',
+ column_name => [ $$result{column_name} ],
+ table_name => $$result{tab_name}
+ };
+ }
+
+ }
+ }
+
+ $statement .= join ",\n", @col_defs;
+ $statement .= "\n);\n";
+ push @statements, $statement;
+
+ foreach ( keys %indices ) {
+ my %index = %{ $indices{$_} };
+ push @statements,
+ "CREATE$index{unique} INDEX \"$_\" ON \"$index{table_name}\" ("
+ . join( ', ', map { '"' . $_ . '"' } @{ $index{column_name} } )
+ . ");\n";
+ }
+
+ }
+ return $statements[0] if @statements == 1;
+ return @statements;
+}
+
+
1;
Modified: trunk/ebase/lib/Everything/DB/Test/Pg.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/Test/Pg.pm 2007-05-22 23:11:06 UTC (rev 955)
+++ trunk/ebase/lib/Everything/DB/Test/Pg.pm 2007-05-22 23:11:44 UTC (rev 956)
@@ -655,4 +655,95 @@
local $TODO = "Unimplemented";
}
+
+sub test_get_create_table : Test(8) {
+ my $self = shift;
+
+ my $dbh = $self->{instance}->{dbh};
+ $dbh->clear;
+ my $var = 0;
+
+ my @returns;
+
+ my $renew_returns = sub {
+ @returns = ();
+ for ( 1 .. 3 ) {
+ push @returns,
+ {
+ field => $_,
+ type => $_,
+ notnull => $_ % 3,
+ length => $_,
+ lengthvar => $_,
+ attnum => $_
+ };
+ }
+ };
+
+ $renew_returns->();
+
+ $dbh->mock( 'fetchrow_hashref' => sub { shift @returns } );
+
+ my @frar_returns = ( ["default value"] );
+ $dbh->mock( fetchrow_arrayref => sub { shift @frar_returns } );
+
+ my @create = $self->{instance}->get_create_table('atable');
+
+ my ( $method, $args ) = $dbh->next_call;
+ is( $method, 'prepare', '...prepares statement' );
+ is(
+ $$args[1],
+"SELECT a.attnum, a.attname AS field, t.typname as type, a.attlen AS length, a.atttypmod as lengthvar, a.attnotnull as notnull
+ FROM pg_type t, pg_class c,
+ pg_attribute a
+
+ WHERE c.relname = ?
+ AND a.attnum > 0
+ AND a.attrelid = c.oid
+ AND a.atttypid = t.oid
+ ORDER BY a.attnum",
+ '...creates sql to retrieve attributes and data types.'
+ );
+ is_deeply(
+ \@create,
+ [
+ "CREATE TABLE \"atable\" (
+\t\"1\" 1 DEFAULT default value NOT NULL,
+\t\"2\" 2 NOT NULL,
+\t\"3\" 3
+);
+"
+ ],
+ '...and returns a list of create statements.'
+ );
+
+ $dbh->clear;
+
+ $renew_returns->();
+ @create =
+ $self->{instance}->get_create_table( 'btable', 'atable', 'ctable' );
+ ( $method, $args ) = $self->{instance}->{dbh}->next_call;
+ is( $method, 'prepare', '...prepares statement' );
+ like( $$args[1], qr/pg_class/, '...creates sql.' );
+ is( scalar @create, 3, '...and returns a list' );
+
+ $dbh->clear;
+ my @list = qw/ atable btable /;
+ $self->{instance}->{dbh}->mock(
+ 'fetchrow',
+ sub {
+ my $r = shift @list;
+ return () unless $r;
+ return ($r);
+ }
+ );
+
+ $renew_returns->();
+
+ @create = $self->{instance}->get_create_table();
+ like( $create[1], qr/CREATE TABLE "btable"/, '...returns all tables.' );
+ like( $create[0], qr/CREATE TABLE "atable"/, '...returns all tables.' );
+
+}
+
1;
Modified: trunk/ebase/lib/Everything/DB/Test/mysql.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/Test/mysql.pm 2007-05-22 23:11:06 UTC (rev 955)
+++ trunk/ebase/lib/Everything/DB/Test/mysql.pm 2007-05-22 23:11:44 UTC (rev 956)
@@ -402,4 +402,48 @@
'2 - 1', '... makes a string from the arguments.' );
}
+
+sub test_get_create_table : Test(7) {
+ my $self = shift;
+
+ my $dbh = $self->{instance}->{dbh};
+ $dbh->clear;
+ my @returns = map { { 'Create Table' => $_ } } qw/one two three/;
+ $dbh->mock( 'fetchrow_hashref' => sub { shift @returns } );
+ my @create = $self->{instance}->get_create_table('atable');
+
+ my ( $method, $args ) = $self->{instance}->{dbh}->next_call;
+ is( $method, 'prepare', '...prepares statement' );
+ is( $$args[1], "show create table atable",
+ '...creates one sql statement/' );
+ is_deeply( \@create, [qw/one/], '...and returns a list' );
+
+ $dbh->clear;
+
+ @returns = map { { 'Create Table' => $_ } } qw/one two three/;
+ @create =
+ $self->{instance}->get_create_table( 'btable', 'atable', 'ctable' );
+ ( $method, $args ) = $self->{instance}->{dbh}->next_call;
+ is( $method, 'prepare', '...prepares statement' );
+ is( $$args[1], "show create table btable", '...creates sql.' );
+ is_deeply( \@create, [qw/one two three/], '...and returns a list' );
+
+ $dbh->clear;
+ my @list = qw/ atable btable /;
+ $self->{instance}->{dbh}->mock(
+ 'fetchrow',
+ sub {
+ my $r = shift @list;
+ return () unless $r;
+ return ($r);
+ }
+ );
+
+ @returns = map { { 'Create Table' => $_ } } qw/one two/;
+ @create = $self->{instance}->get_create_table();
+ is_deeply( \@create, [qw/ one two /], '...returns all tables.' );
+
+}
+
+
1;
Modified: trunk/ebase/lib/Everything/DB/Test/sqlite.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/Test/sqlite.pm 2007-05-22 23:11:06 UTC (rev 955)
+++ trunk/ebase/lib/Everything/DB/Test/sqlite.pm 2007-05-22 23:11:44 UTC (rev 956)
@@ -417,4 +417,33 @@
'2 - 1', '... makes a string from the arguments.' );
}
+sub test_get_create_table : Test(6) {
+ my $self = shift;
+
+ my $dbh = $self->{instance}->{dbh};
+ $dbh->clear;
+ my @returns = map { [ $_ ] } qw/one two three/;
+ $dbh->mock('fetchrow_arrayref' => sub { shift @returns });
+ my @create = $self->{instance}->get_create_table('atable');
+
+ my ($method, $args) = $self->{instance}->{dbh}->next_call;
+ is ($method, 'prepare', '...prepares statement');
+ is ($$args[1], "select sql from sqlite_master where type = 'table' and name = 'atable'", '...creates sql with one where');
+ is_deeply (\@create, [ qw/one two three/ ], '...and returns a list');
+
+ $dbh->clear;
+
+ @create = $self->{instance}->get_create_table('atable', 'btable', 'ctable');
+ ($method, $args) = $self->{instance}->{dbh}->next_call;
+ is ($method, 'prepare', '...prepares statement');
+ is ($$args[1], "select sql from sqlite_master where type = 'table' and name = 'atable' or name = 'btable' or name = 'ctable'", '...creates sql with three wheres');
+
+ $dbh->clear;
+
+ @create = $self->{instance}->get_create_table();
+ ($method, $args) = $self->{instance}->{dbh}->next_call;
+ is ($$args[1], "select sql from sqlite_master where type = 'table'", '...creates sql with no where');
+
+}
+
1;
Modified: trunk/ebase/lib/Everything/DB/mysql.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/mysql.pm 2007-05-22 23:11:06 UTC (rev 955)
+++ trunk/ebase/lib/Everything/DB/mysql.pm 2007-05-22 23:11:44 UTC (rev 956)
@@ -426,4 +426,32 @@
return $this->getDatabaseHandle()->last_insert_id(undef, undef, undef, undef);
}
+
+
+=head2 C<get_create_table>
+
+Returns the create table statements of the tables whose names were passed as arguments
+
+Returns a list if there is more than one table or a string if there is only one.
+
+=cut
+
+sub get_create_table {
+
+ my ( $self, @tables ) = @_;
+
+ @tables = $self->list_tables unless @tables;
+ my @statements = ();
+ my $dbh = $self->{dbh};
+
+ foreach ( @tables ) {
+ my $sth = $dbh->prepare("show create table $_") || die $DBI::errstr;
+ $sth->execute;
+ my $result = $sth->fetchrow_hashref;
+ push @statements, $result->{'Create Table'};
+ }
+ return $statements[0] if @statements == 1;
+ return @statements;
+}
+
1;
Modified: trunk/ebase/lib/Everything/DB/sqlite.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/sqlite.pm 2007-05-22 23:11:06 UTC (rev 955)
+++ trunk/ebase/lib/Everything/DB/sqlite.pm 2007-05-22 23:11:44 UTC (rev 956)
@@ -390,6 +390,33 @@
return @tables;
}
+=head2 C<get_create_table>
+
+Returns the create table statements of the tables whose names were passed as arguments
+
+Returns a list if there is more than one table or a string if there is only one.
+
+=cut
+
+sub get_create_table {
+
+ my ( $self, @tables ) = @_;
+
+ my @statements = ();
+ my $dbh = $self->{dbh};
+
+ my $where = " where type = 'table'";
+ $where .= " and " . join ' or ', map { "name = '$_'" } @tables if @tables;
+ my $sth = $dbh->prepare( "select sql from sqlite_master" . $where) || die $DBI::errstr;
+ $sth->execute;
+ while (my $sql = $sth->fetchrow_arrayref) {
+ push @statements, @$sql;
+ }
+
+ return $statements[0] if @statements == 1;
+ return @statements;
+}
+
sub now { return "datetime('now')" }
sub timediff { "$_[1] - $_[2]" }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:12:25
|
Revision: 957
http://svn.sourceforge.net/everydevel/?rev=957&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:12:13 -0700 (Tue, 22 May 2007)
Log Message:
-----------
Move node title search into NodeBase.pm to move SQL out of Everything.pm and
allow DB independent and flexible title search.
Modified Paths:
--------------
trunk/ebase/lib/Everything/NodeBase.pm
trunk/ebase/lib/Everything/Test/NodeBase.pm
trunk/ebase/lib/Everything/Test.pm
trunk/ebase/lib/Everything.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:982
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:983
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/NodeBase.pm
===================================================================
--- trunk/ebase/lib/Everything/NodeBase.pm 2007-05-22 23:11:44 UTC (rev 956)
+++ trunk/ebase/lib/Everything/NodeBase.pm 2007-05-22 23:12:13 UTC (rev 957)
@@ -680,4 +680,61 @@
return Everything::Security::checkPermissions( $perms, $modes );
}
+
+=head2 C<search_node_title>
+
+Applies a search algorithm to words passed as arguments
+
+=over 4
+
+=item *
+
+Takes an array ref of words to search on
+
+
+=item *
+
+And an array ref of nodetypes to search on
+
+
+=back
+
+Returns an array of hash refs.
+
+=cut
+
+sub search_node_name {
+
+ my ( $self, $words, $types ) = @_;
+ my $match = '';
+
+ $types = [$types] if defined $types and $types and ref($types) eq "SCALAR";
+
+ my $typestr = '';
+ if ( ref($types) eq 'ARRAY' and @$types ) {
+ my $t = shift @$types;
+ $typestr .= "AND (type_nodetype = " . $self->getId($t);
+ foreach (@$types) {
+ $typestr .= " OR type_nodetype = " . $self->getId($_);
+ }
+
+ $typestr .= ')';
+ }
+
+ $match = '%' . join( '%', @$words ) . '%';
+ my $cursor =
+ $self->{storage}
+ ->sqlSelectMany( "*", "node", "title like ? $typestr", undef, [$match] );
+
+ return unless $cursor;
+
+ my @ret;
+ while ( my $m = $cursor->fetchrow_hashref ) {
+ push @ret, $m;
+ }
+
+ return \@ret;
+
+}
+
1;
Modified: trunk/ebase/lib/Everything/Test/NodeBase.pm
===================================================================
--- trunk/ebase/lib/Everything/Test/NodeBase.pm 2007-05-22 23:11:44 UTC (rev 956)
+++ trunk/ebase/lib/Everything/Test/NodeBase.pm 2007-05-22 23:12:13 UTC (rev 957)
@@ -504,4 +504,67 @@
is( $result, 'cp', '... and returning results' );
}
+sub test_search_node_name : Test(10) {
+ my $self = shift;
+
+ my $nb = $self->{nb};
+
+ my $mock = Test::MockObject->new;
+
+ my $id = [];
+
+ my $fake_nodes = { foo => 1, bar => 2 };
+ $nb->mock(
+ 'getId',
+ sub {
+ push @$id, $fake_nodes->{ $_[1] };
+ return $fake_nodes->{ $_[1] };
+ }
+ )->set_always( 'getNode', $mock );
+
+ $mock->set_series( 'fetchrow_hashref', 1, 2, 3 );
+
+ $nb->{storage}->set_always( sqlSelectMany => undef );
+
+ is( $nb->search_node_name(['']),
+ undef,
+ 'searchNodeName() should return without workable words to find' );
+
+ $nb->{storage}->set_always( sqlSelectMany => $mock );
+ $mock->set_always( fetchfow_hashref => undef );
+ $nb->{storage}->clear;
+ $mock->clear;
+ $nb->search_node_name( [''], [ 'foo', 'bar' ] );
+ is( $id->[0], 1, '... should call getId() for first type' );
+ is( $id->[1], 2,
+ '... should call getId() for subsequent types (if passed)' );
+
+ my ( $method, $args ) = $nb->{storage}->next_call;
+ is ($method, 'sqlSelectMany', '...calls execute against the db cursor.');
+ is ($$args[3], 'title like ? AND (type_nodetype = 1 OR type_nodetype = 2)', '... creates sql for types.');
+ $nb->{storage}->clear;
+ $mock->clear;
+
+ $nb->search_node_name(['quote']);
+ ( $method, $args ) = $nb->{storage}->next_call;
+ is_deeply( $$args[5], [q{%quote%}],
+ '... should process searchable words' );
+
+ # reset series
+ $mock->set_series( 'fetchrow_hashref', 1, 2, 3 );
+
+ $nb->{storage}->clear;
+ $mock->clear;
+
+ my $found =
+ $nb->search_node_name( ['ab', 'aBc!', 'abcd', 'a', 'ee'], [ 'foo', 'bar' ] );
+ ( $method, $args ) = $nb->{storage}->next_call;
+ is_deeply( $$args[5], ['%ab%aBc!%abcd%a%ee%'], '... processes all search word arguments.' );
+
+ is( ref $found, 'ARRAY', '... should return an arrayref on success' );
+
+ is( @$found, 3, '... should find all proper results' );
+ is( join( '', @$found ), '123', '... and should return results' );
+}
+
1;
Modified: trunk/ebase/lib/Everything/Test.pm
===================================================================
--- trunk/ebase/lib/Everything/Test.pm 2007-05-22 23:11:44 UTC (rev 956)
+++ trunk/ebase/lib/Everything/Test.pm 2007-05-22 23:12:13 UTC (rev 957)
@@ -375,13 +375,12 @@
'getBacksideErrors() should return reference to @bsErrors' );
}
-sub test_searchNodeName : Test(12) {
+sub test_searchNodeName : Test(8) {
my $self = shift;
local $Everything::DB = Test::MockObject->new;
my $mock = Test::MockObject->new;
my $quotes;
my $id = [];
- my @calls;
my $fake_nodes = { foo => 1, bar => 2 };
$Everything::DB->mock(
'getId',
@@ -389,11 +388,7 @@
push @$id, $fake_nodes->{ $_[1] };
return $fake_nodes->{ $_[1] };
}
- )->set_always( 'getNode', $mock )
- ->set_always( 'getDatabaseHandle', $mock )->mock(
- 'sqlSelectMany',
- sub { push @calls, [ 'sqlSelectMany', @_ ]; $mock }
- );
+ )->set_always( 'getNode', $mock );
$mock->mock( 'quote', sub { my $r = qq{'$_[1]'}; $quotes .= $r; $r; } );
$mock->set_series( 'fetchrow_hashref', 1, 2, 3 );
@@ -401,46 +396,28 @@
## to test skipped words
$mock->set_always( getVars => { ab => 1, abcd => 1, } );
+ $Everything::DB->set_always( search_node_name => [ 1, 2, 3 ] );
+
is( Everything::searchNodeName(''),
undef,
'searchNodeName() should return without workable words to find' );
- Everything::searchNodeName( '', [ 'foo', 'bar' ] );
- is( $id->[0], 1, '... should call getId() for first type' );
- is( $id->[1], 2,
- '... should call getId() for subsequent types (if passed)' );
-
+ $Everything::DB->clear;
Everything::searchNodeName('quote');
- is( $quotes, q{'[[:<:]]quote[[:>:]]'},
- '... should quote() searchable words' );
- # reset series
- $mock->set_series( 'fetchrow_hashref', 1, 2, 3 );
+ my ($method, $args) = $Everything::DB->next_call(2);
+ is ($method, 'search_node_name');
+ is_deeply( $args->[1], [q{quote}],
+ '... passes searchable words to search function' );
+ $Everything::DB->clear;
my $found =
Everything::searchNodeName( 'ab aBc! abcd a ee', [ 'foo', 'bar' ] );
- like( $quotes, qr/abc\\!/, '... should escape nonword chars too' );
+ ($method, $args) = $Everything::DB->next_call(2);
+ is ($method, 'search_node_name', '...calls search node name.');
+ is_deeply( $args->[1], ['aBc!'], '... strips out unwanted strings.' );
- is( $calls[-1]->[0], 'sqlSelectMany',
- '... should sqlSelectMany() matching titles' );
- like(
- $calls[-1]->[2],
- qr/\*.+?lower.title.+?rlike.+abc.+/,
- '... selecting by title with regexes'
- );
-
- like(
- $calls[-1]->[4],
- qr/AND .type_nodetype = 1 OR type_nodetype = 2/,
- '... should constrain by type, if provided'
- );
- is(
- $calls[-1]->[5],
- 'ORDER BY matchval DESC',
- '... and should order results properly'
- );
-
is( ref $found, 'ARRAY', '... should return an arrayref on success' );
is( @$found, 3, '... should find all proper results' );
Modified: trunk/ebase/lib/Everything.pm
===================================================================
--- trunk/ebase/lib/Everything.pm 2007-05-22 23:11:44 UTC (rev 956)
+++ trunk/ebase/lib/Everything.pm 2007-05-22 23:12:13 UTC (rev 957)
@@ -486,20 +486,6 @@
my ( $searchWords, $TYPE ) = @_;
my $typestr = '';
- $TYPE = [$TYPE] if defined $TYPE and $TYPE and ref($TYPE) eq "SCALAR";
-
- if ( ref($TYPE) eq 'ARRAY' and @$TYPE )
- {
- my $t = shift @$TYPE;
- $typestr .= "AND (type_nodetype = " . getId($t);
- foreach (@$TYPE)
- {
- $typestr .= " OR type_nodetype = " . getId($_);
- }
-
- $typestr .= ')';
- }
-
my $NOSEARCH = getNode( 'stopwords', 'setting' );
my $NOWORDS = $NOSEARCH ? $NOSEARCH->getVars() : {};
@@ -507,35 +493,7 @@
split ' ', $searchWords;
return unless @words;
-
- my $match = '';
- foreach my $word (@words)
- {
- $word = lc($word);
- $word =~ s/(\W)/\\$1/gs;
- $word = '[[:<:]]' . $word . '[[:>:]]';
- $word =
- "(lower(title) rlike "
- . $DB->getDatabaseHandle()->quote($word) . ")";
- }
-
- $match = '(' . join( ' + ', @words ) . ')';
- my $cursor = $DB->sqlSelectMany(
- "*, $match AS matchval",
- "node",
- "$match >= 1 $typestr",
- "ORDER BY matchval DESC"
- );
-
- return unless $cursor;
-
- my @ret;
- while ( my $m = $cursor->fetchrow_hashref )
- {
- push @ret, $m;
- }
-
- return \@ret;
+ return $DB->search_node_name(\@words, $TYPE);
}
=cut
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:12:45
|
Revision: 958
http://svn.sourceforge.net/everydevel/?rev=958&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:12:39 -0700 (Tue, 22 May 2007)
Log Message:
-----------
Nodebase connection utility function for command line and tests
Modified Paths:
--------------
trunk/ebase/lib/Everything/CmdLine.pm
trunk/ebase/lib/Everything/Test/CmdLine.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:983
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:985
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/CmdLine.pm
===================================================================
--- trunk/ebase/lib/Everything/CmdLine.pm 2007-05-22 23:12:13 UTC (rev 957)
+++ trunk/ebase/lib/Everything/CmdLine.pm 2007-05-22 23:12:39 UTC (rev 958)
@@ -7,16 +7,18 @@
use strict;
use warnings;
-our @EXPORT_OK = qw(get_options abs_path);
+our @EXPORT_OK = qw(get_options abs_path usage_options make_nodebase);
Getopt::Long::Configure(qw/bundling/);
sub get_options {
- my ($usage_msg) = @_;
+ my ($usage_msg, $other_options) = @_;
+ $other_options ||= [];
my %opts;
+ $opts{database} = $opts{port} = $opts{host} = $opts{password} = $opts{user} = '';
GetOptions(
\%opts, 'user|u=s', 'password|p=s', 'host|h=s',
- 'database|d=s', 'port|P=s', 'type|t=s'
+ 'database|d=s', 'port|P=s', 'type|t=s', @$other_options
) or usage_options($usage_msg);
return \%opts;
@@ -27,7 +29,7 @@
$usage_msg ||= "Usage:\n\n";
$usage_msg .= <<USAGE;
-Takes the following options:
+Takes the following standard options:
\t -d
\t --database
\t\t the db name. In the case of sqlite, it will be the file name of the test db, it will not be deleted on completion. If no name is specified a temporary file will be used if possible. The temporary file will be deleted on completion. In the case of mysql or postgresql, it is the name of the database to use.
@@ -75,4 +77,30 @@
}
+=cut
+
+=head2 C<make_nodebase>
+
+Takes a hash reference like the one returned by get_options(). Returns a nodebase object if it can get one.
+
+=cut
+
+sub make_nodebase {
+ my ($opts) = @_;
+
+ $$opts{type} ||= 'sqlite';
+ $$opts{user} ||= $ENV{USER};
+ $$opts{host} ||= 'localhost';
+
+ my $nb =
+ Everything::NodeBase->new(
+ "$$opts{database}:$$opts{user}:$$opts{password}:$$opts{host}",
+ 1, $$opts{type} );
+ croak
+"Can't connect to nodebase using database '$$opts{database}', user '$$opts{user}', password '$$opts{password}', host '$$opts{host}' and type '$$opts{type}'"
+ unless $nb;
+
+ return $nb;
+}
+
1;
Modified: trunk/ebase/lib/Everything/Test/CmdLine.pm
===================================================================
--- trunk/ebase/lib/Everything/Test/CmdLine.pm 2007-05-22 23:12:13 UTC (rev 957)
+++ trunk/ebase/lib/Everything/Test/CmdLine.pm 2007-05-22 23:12:39 UTC (rev 958)
@@ -2,6 +2,8 @@
use Test::More;
use Test::Warn;
+use Test::MockObject;
+use Test::Exception;
use Cwd;
use warnings;
use strict;
@@ -88,4 +90,50 @@
}
+
+sub test_make_nodebase : Test(5) {
+ my $self = shift;
+ can_ok( $self->{class}, 'make_nodebase' )
+ || return 'abs_path not implemented.';
+
+ my $mock = Test::MockObject->new;
+ $mock->fake_module('Everything::NodeBase');
+
+ my @new_args;
+ my $new_returns = $mock;
+ local *Everything::NodeBase::new;
+ *Everything::NodeBase::new = sub { @new_args = @_; return $new_returns };
+
+ my $test_code = \&{ $self->{class} . '::make_nodebase' };
+ my $opts = {
+ database => 'dbname',
+ user => 'dbuser',
+ password => 'dbpassword',
+ host => 'dbhost',
+ type => 'dbtype',
+ port => 'dbport'
+ };
+ my $rv = $test_code->($opts);
+ is_deeply(
+ \@new_args,
+ [
+ 'Everything::NodeBase', "dbname:dbuser:dbpassword:dbhost",
+ 1, 'dbtype'
+ ],
+ '...args are handled properly.'
+ );
+ is( "$rv", $mock, '...returns the return value of NodeBase\'s new.' );
+
+ $opts = { database => 'dbname', password => '' };
+ $rv = $test_code->($opts);
+ is_deeply(
+ \@new_args,
+ [ 'Everything::NodeBase', "dbname:$ENV{USER}::localhost", 1, 'sqlite' ],
+ '...defaults are set.'
+ );
+
+ undef $new_returns;
+ dies_ok { $test_code->($opts) } '...dies if no nodebase found.';
+}
+
1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:13:10
|
Revision: 959
http://svn.sourceforge.net/everydevel/?rev=959&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:13:06 -0700 (Tue, 22 May 2007)
Log Message:
-----------
FIX: 'wrap' attribute is not XHTML compliant
Modified Paths:
--------------
trunk/ebase/lib/Everything/HTML/FormObject/Test/TextArea.pm
trunk/ebase/lib/Everything/HTML/FormObject/TextArea.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:985
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:992
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/HTML/FormObject/Test/TextArea.pm
===================================================================
--- trunk/ebase/lib/Everything/HTML/FormObject/Test/TextArea.pm 2007-05-22 23:12:39 UTC (rev 958)
+++ trunk/ebase/lib/Everything/HTML/FormObject/Test/TextArea.pm 2007-05-22 23:13:06 UTC (rev 959)
@@ -10,7 +10,7 @@
use SUPER;
use warnings;
-sub test_gen_object : Test(15) {
+sub test_gen_object : Test(13) {
my $self = shift;
my $instance = Test::MockObject::Extends->new( $self->{instance} );
my $cgi = Test::MockObject->new;
@@ -35,7 +35,7 @@
is(
$params[0],
- 'query, bindNode, field, name, default, cols, rows, wrap ' . $cgi
+ 'query, bindNode, field, name, default, cols, rows ' . $cgi
. ' bN f n d c r w',
'genObject() should call getParamArray() with @_'
);
@@ -47,7 +47,6 @@
is( $args->[2], 'n', '... should use provided name' );
is( $args->[6], 'c', '... should use provided cols' );
is( $args->[8], 'r', '... should use provided rows' );
- is( $args->[10], 'w', '... should use provided wrap' );
is( $result, "html\na",
'... returning concatenation of SUPER() and textfield() calls' );
@@ -57,7 +56,6 @@
'... with no default value, should bind to node field (if provided)' );
is( $args->[6], 80, '... cols should default to 80' );
is( $args->[8], 20, '... rows should default to 20' );
- is( $args->[10], 'virtual', '... wrap should default to "virtual"' );
is( $args->[2], 'f', '... name should default to node field name' );
$instance->genObject( $cgi, '', 'f', 'n', '' );
Modified: trunk/ebase/lib/Everything/HTML/FormObject/TextArea.pm
===================================================================
--- trunk/ebase/lib/Everything/HTML/FormObject/TextArea.pm 2007-05-22 23:12:39 UTC (rev 958)
+++ trunk/ebase/lib/Everything/HTML/FormObject/TextArea.pm 2007-05-22 23:13:06 UTC (rev 959)
@@ -70,16 +70,16 @@
sub genObject
{
my $this = shift @_;
- my ( $query, $bindNode, $field, $name, $default, $cols, $rows, $wrap ) =
+ my ( $query, $bindNode, $field, $name, $default, $cols, $rows, ) =
getParamArray(
- "query, bindNode, field, name, default, cols, rows, wrap", @_ );
+ "query, bindNode, field, name, default, cols, rows ", @_ );
$name ||= $field;
$default ||= 'AUTO';
$cols ||= 80;
$rows ||= 20;
- $wrap ||= 'virtual';
+
my $html =
$this->SUPER::genObject( $query, $bindNode, $field, $name ) . "\n";
@@ -94,7 +94,6 @@
-default => $default,
-cols => $cols,
-rows => $rows,
- -wrap => $wrap
);
return $html;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:14:11
|
Revision: 960
http://svn.sourceforge.net/everydevel/?rev=960&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:14:00 -0700 (Tue, 22 May 2007)
Log Message:
-----------
New method-based flexible parsing system for parseable and runnable nodes.
Modified Paths:
--------------
trunk/ebase/lib/Everything/Node/Test/htmlpage.pm
trunk/ebase/lib/Everything/Node/container.pm
trunk/ebase/lib/Everything/Node/htmlcode.pm
trunk/ebase/lib/Everything/Node/htmlpage.pm
trunk/ebase/lib/Everything/Node/htmlsnippet.pm
trunk/ebase/lib/Everything/Node/nodegroup.pm
trunk/ebase/lib/Everything/Node/nodelet.pm
trunk/ebase/lib/Everything/Node/superdoc.pm
Added Paths:
-----------
trunk/ebase/lib/Everything/Node/Parseable.pm
trunk/ebase/lib/Everything/Node/Runnable.pm
trunk/ebase/lib/Everything/Node/Test/Parseable.pm
trunk/ebase/lib/Everything/Node/Test/Runnable.pm
trunk/ebase/t/Node/parseable.t
trunk/ebase/t/Node/runnable.t
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:992
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:994
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Added: trunk/ebase/lib/Everything/Node/Parseable.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Parseable.pm (rev 0)
+++ trunk/ebase/lib/Everything/Node/Parseable.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -0,0 +1,255 @@
+package Everything::Node::Parseable;
+
+use SUPER;
+use base 'Everything::Node::Runnable';
+use strict;
+use warnings;
+
+
+=head1 <tokens_to_perl>
+
+This is a function.
+
+It takes two arguments: an array ref of tokens and a call back. Turns each token into executable perl in accordance with the dispatch table returned by the method 'get_handlers'.
+
+Returns an array ref.
+
+=cut
+
+sub tokens_to_perl {
+ my ( $tokens, $error_cb ) = @_;
+
+ my $dispatch_table = get_handlers();
+
+ my @encoded = ();
+ foreach (@$tokens) {
+ my ( $token, $text ) = @$_;
+ my $encoded = $dispatch_table->{$token}->($text);
+
+ if ( $error_cb && $token ne 'TEXT' ) {
+ $encoded .= $error_cb->() || '';
+ }
+
+ push @encoded, [ $token => $encoded ];
+ }
+
+ return \@encoded;
+
+}
+
+
+=head1 C<compile>
+
+Overrides the super class compile.
+
+Takes one argument which is the text to be compiled and sends it to
+the parser before being compiled.
+
+=cut
+
+sub compile {
+ my ( $self, $text ) = @_;
+
+ my $code = $self->parse($text);
+ return $self->SUPER($code);
+}
+
+sub basic_handler {
+ my ($specific_cb) = @_;
+
+ return sub {
+ my ($text) = @_;
+ $text =~ s!"!\"!g;
+ $text = $specific_cb->($text);
+ my $wrapped = " eval {$text} || '';\n";
+ return $wrapped;
+ };
+
+}
+
+## class variable
+my %handlers;
+
+sub set_default_handlers {
+ %handlers = (
+ HTMLCODE => basic_handler(
+ sub {
+ my ( $func, $args ) = split( /\s*:\s*/, $_[0] );
+
+ my $rv = " $func(";
+ if ( defined $args ) {
+ my @args = do_args($args);
+ $rv .= join( ", ", @args ) if (@args);
+ }
+ $rv .= ") ";
+ return $rv;
+ }
+ ),
+ TEXT => sub {
+ my $text = shift;
+ $text =~ s!\'!\\'!g;
+ return " '$text';";
+ },
+ HTMLSNIPPET =>
+ basic_handler( sub { "htmlsnippet('$_[0]')" } ),
+ PERL => basic_handler( sub { " \n$_[0]\n" } ),
+ );
+}
+
+BEGIN { set_default_handlers() }
+
+sub get_handlers {
+ \%handlers;
+}
+
+sub delete_handlers {
+ %handlers = ();
+
+}
+
+sub set_handler {
+ my ( $self, $text_type, $code ) = @_;
+ $handlers{$text_type} = $code;
+}
+
+=head1 C<tokenise>
+
+This is a function.
+
+It takes one argument of text and splits it into 'tokens'.
+
+Text wrapped in [{ }] is labelled 'HTMLCODE'.
+
+Text wrapped in [% %] or [" "] is labelled 'PERL'
+
+Text wrapped in [< >] is labelled 'HTMLSNIPPET'.
+
+Everything else is labelled 'TEXT'.
+
+Returns an array ref of array refs. These latter have two elements 'LABEL' and 'text'
+
+=cut
+
+sub tokenise {
+ my ($text) = @_;
+
+ my @tokens;
+
+ for my $chunk ( split( /(\[(?:\{.*?\}|\".*?\"|%.*?%|<.*?>)\])/s, $text ) ) {
+ next unless $chunk =~ /\S/;
+
+ my ( $start, $code, $end );
+ if ( ( $start, $code, $end ) =
+ $chunk =~ /^\[([%"<{])(.+?)([%">}])\]$/s )
+ {
+
+ if ( $start eq '{' ) {
+ push @tokens, [ 'HTMLCODE', $code ];
+ }
+ elsif ( $start eq '<' ) {
+ push @tokens, [ 'HTMLSNIPPET', $code ];
+ }
+ elsif ( $start eq '"' or $start eq '%' ) {
+ push @tokens, [ 'PERL', $code ];
+ }
+ }
+ else {
+
+ next unless ( $chunk =~ /\S/ );
+ push @tokens, [ 'TEXT', $chunk ];
+ }
+ }
+ return \@tokens;
+}
+
+
+sub add_error_text {
+ my ($CURRENTNODE) = @_;
+
+ my $error_text = qq|\nEverything::logErrors('', \$\@, '', { title =>
+ '\Q$$CURRENTNODE{title}\E', node_id => '$$CURRENTNODE{node_id}' })
+ if (\$\@);\n|;
+ return $error_text;
+}
+
+=head1 C<parse>
+
+This looks for code wrapped in:
+
+=over 4
+
+=item C<[{ }]>
+
+In which case the enclosed is the name of an htmlcode node which must be retrieved form the db and executed.
+
+
+=item C<[< >]>
+
+In which case the enclosed is the name of an htmlsnippet which must be retrieved from the db.
+
+=item C<[% %]>
+
+In which case the enclosed is perl
+
+=item C<[" "]>
+
+Once again, the enclosed is perl
+
+=back
+
+Everything else is text or html.
+
+
+
+=cut
+
+sub parse {
+ my $self = shift;
+ my $data = shift;
+ my $tokens = tokenise($data);
+ my $encoded_tokens =
+ tokens_to_perl( $tokens, sub { add_error_text($self) } );
+
+ my $text = 'my $result;' . "\n\n";
+
+ $text .= join '', map { '$result .= ' . $_->[1] . "\n\n" }
+ grep /\S/, @$encoded_tokens;
+
+ $text .= 'return $result;';
+ return $text;
+
+}
+
+=head2 C<do_args>
+
+This is a supporting function for compileCache(). It turns a comma-delimited
+list of arguments into an array, performing variable interpolation on them.
+It's probably not necessary once things move over to the new AUTOLOAD htmlcode
+scheme.
+
+=over 4
+
+=item * $args
+
+a comma-delimited list of arguments
+
+=back
+
+Returns an array of manipulated arguments.
+
+=cut
+
+sub do_args {
+ my $args = shift;
+ $args =~ s/\s+$//;
+ my @args = split( /\s*,\s*/, $args ) or ();
+ foreach my $arg (@args) {
+ unless ( $arg =~ /^\$/ ) {
+ $arg = "'" . $arg . "'";
+ }
+ }
+
+ return @args;
+}
+
+1;
Property changes on: trunk/ebase/lib/Everything/Node/Parseable.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/lib/Everything/Node/Runnable.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Runnable.pm (rev 0)
+++ trunk/ebase/lib/Everything/Node/Runnable.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -0,0 +1,143 @@
+package Everything::Node::Runnable;
+
+use Everything ();
+use Everything::HTML;
+
+use base 'Class::Accessor';
+__PACKAGE__->follow_best_practice;
+
+use strict;
+use warnings;
+
+
+
+sub run {
+ my ( $self, $field, $no_cache, @args) = @_;
+
+ $field ||= $self->get_compilable_field;
+
+ if ( $no_cache ) {
+
+ my $code = $self->compile( $self->{$field} );
+ return $self->eval_code( $code, $field, \@args );
+ }
+
+ my $ret = $self->execute_cached_code( $field, \@args );
+ return $ret if $ret;
+ my $code = $self->compile( $self->{ $field } );
+ die "Cache failed" unless $self->cache_code( $field, $code );
+ return $self->execute_cached_code( $field, \@args );
+
+}
+
+
+sub cache_code {
+ my ($self, $field, $code_ref) = @_;
+ $field ||= $self->get_compilable_field;
+
+ return 1 if $self->{DB}->{cache}->cacheMethod($self, $field, $code_ref);
+
+
+}
+
+sub execute_cached_code {
+ my ($self, $field, $args) = @_;
+
+ $field ||= $self->get_compilable_field;
+
+ $args ||= [];
+
+ my $code_ref;
+
+ if ($code_ref = $self->{"_cached_$field"}) {
+
+ if (ref($code_ref) eq 'CODE' and defined &$code_ref) {
+
+
+ return $self->eval_code($code_ref, $field, $args);
+ }
+ }
+}
+
+
+sub compile {
+ my ( $self, $code ) = @_;
+
+ my $anon = Everything::HTML::createAnonSub($code);
+ return Everything::HTML::make_coderef($anon, $self);
+
+
+}
+
+sub get_compilable_field {
+
+ die "Sub-class responsibility";
+
+}
+
+sub eval_code {
+ my $self = shift;
+ my $sub = shift;
+ my $field = shift;
+ $field ||= $self->get_compilable_field;
+ my @args = @_;
+
+
+ my $html = Everything::HTML::execute_coderef( $sub, $field, $self, @args );
+ return $html;
+}
+
+
+sub createAnonSub {
+ my ($self, $code) = @_;
+
+### package name as to be put here to make sure we know which subs we are executing --------- set up environment
+ "sub {
+ $code
+ }\n";
+}
+
+=head2 C<compileCache>
+
+Common compilation and caching and initial calling of htmlcode and
+nodemethod functions. Hopefully it keeps common code in one spot. For
+internal use only!
+
+=over 4
+
+=item * $code
+
+the text to eval() into an anonymous subroutine
+
+=item * $NODE
+
+the node object from which the code came
+
+=item * $field
+
+the field of the node that holds the code for that nodetype
+
+=item * $args
+
+a reference to a list of arguments to pass
+
+=back
+
+Returns a string containing results of the code or a blank string. Undef if
+the compilation fails -- in case we need to default to old behavior.
+
+=cut
+
+sub compileCache
+{
+ my ($self, $code_ref, $args) = @_;
+ my $field = $self->get_compilable_field;
+ my $NODE = $self->getNODE;
+ return unless $code_ref;
+
+ return 1 if $NODE->{DB}->{cache}->cacheMethod($NODE, $field, $code_ref);
+
+}
+
+
+1;
Property changes on: trunk/ebase/lib/Everything/Node/Runnable.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/lib/Everything/Node/Test/Parseable.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Test/Parseable.pm (rev 0)
+++ trunk/ebase/lib/Everything/Node/Test/Parseable.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -0,0 +1,278 @@
+package Everything::Node::Test::Parseable;
+
+
+use base 'Everything::Node::Test::Runnable';
+use Test::More;
+use Test::MockObject;
+use Test::MockObject::Extends;
+use Test::Exception;
+use Scalar::Util 'blessed';
+use SUPER;
+
+use strict;
+
+
+
+sub startup_parseable : Test(startup => +0) {
+ my $self = shift;
+ $self->SUPER;
+ require Everything::Node::Parseable;
+
+
+}
+
+
+sub test_do_args : Test(2) {
+
+ my $self = shift;
+ can_ok( $self->{class}, 'do_args' ) || return;
+ my $arg = "first, sec ond ,third";
+ my $expected_result = [ q{'first'}, q{'sec ond'}, q{'third'} ];
+ my $do_args = \&{ $self->{class} . '::do_args' };
+ is_deeply( [ $do_args->($arg) ],
+ $expected_result,
+ 'do_args turns comma-delimited arguments into an array' );
+
+}
+
+sub test_createAnonSub : Test(2) {
+
+ my $self = shift;
+ can_ok( $self->{class}, 'createAnonSub' ) || return;
+ my $arg = "some random data";
+ like( $self->{instance}->createAnonSub($arg),
+ qr/^\s*sub\s*\{\s*$arg\s*\}/s, 'createAnonSub wraps args in sub{}' );
+
+}
+
+sub test_parse : Test(20) {
+ my $self = shift;
+
+ my $test_suite = htmlcode_hash();
+ foreach ( keys %$test_suite ) {
+
+ $self->{instance}->{title} = 'Fake Node';
+ $self->{instance}->{node_id} = 222;
+ $self->{instance}->{code} = $test_suite->{$_}->{input};
+ my $rv = $self->{instance}->parse($self->{instance}->{code});
+ my $main_code = $test_suite->{$_}->{output};
+ like( $rv, $main_code, "Should wrap $_ code in the right way." );
+
+ ## We also need to test the wrap code:
+ my $start_wrap = qr/^\s*my\s+\$result;\s+\$result\s*\.=\s*/s;
+ like( $rv, $start_wrap, 'Should start the eval block properly' );
+
+ my $error_code = qr//;
+
+ unless ( $_ eq 'TEXT' ) {
+
+ $error_code =
+qr/\s*Everything::logErrors\('',\s+ \$@,\s+ '',\s+ \{\s+ title\s+ =>\s* 'Fake\\\sNode',\s+node_id\s+ =>\s+ '222'\s+ \}\)\s*if\s+\(\$@\);
+/sx;
+ }
+ my $final_code = qr/\s+return\s+\$result\s*;\s*$/sx;
+ like( $rv, qr/$error_code$final_code/,
+ 'Should end the eval block properly' );
+ like(
+ $rv,
+ qr/$start_wrap$main_code$error_code$final_code/,
+ 'The whole lot'
+ );
+ }
+
+}
+
+sub htmlcode_hash {
+ {
+ TEXT => {
+ input => q/Some "text" <html> text's stuff/,
+ output => qr/'Some "text" <html> text\\'s stuff'\s*;/s
+
+ },
+
+ HTMLCODE => {
+ input => q/[{anhtmlcodething: one, two ,three }]/,
+ output =>
+qr/\s*eval\s*\{\s*anhtmlcodething\s*\(\s*'one'\s*,\s*'two'\s*,\s*'three'\s*\)\s+\}\s+\|\|\s+''\s*;/s
+
+ },
+
+ PERL1 => {
+ input => q/[% do { "$stuff" = %thing{3} } while ($x == 2) %]/,
+ output =>
+qr/\s*eval\s*\{\s* do \{ "\$stuff" = %thing\{3\} \} while \(\$x == 2\)\s*\}\s+\|\|\s+''\s*;/s
+ },
+
+ PERL2 => {
+ input => q/[" do { $stuff = "%thing{3}" } while ($x == 2) "]/,
+ output =>
+qr/\s*eval\s*\{\s* do \{ \$stuff = "%thing\{3\}" \} while \(\$x == 2\)\s*\}\s+\|\|\s+''\s*;/s
+ },
+
+### Note the html code does not allow spaced between < and the name of
+### the htmlsnippet
+ HTMLSNIPPET => {
+ input => q/[<htmlsnippettext>]/,
+ output =>
+qr/eval\s*\{\s*htmlsnippet\s*\(\s*'htmlsnippettext'\s*\)\s*\}\s+\|\|\s+''\s*;/s
+
+ },
+ }
+
+}
+
+sub test_make_eval_text : Test(2) {
+ return 'unimplemented';
+ my $self = shift;
+ my $class = $self->{class};
+ my $instance = $self->{instance};
+ can_ok( $class, 'make_eval_text' ) || return;
+ my $make_eval_text = \&{ $class . '::make_eval_text' };
+ my $tokens = [ [ PERL => 'one' ], [ TEXT => 'two' ], [ TEXT => 'three' ] ];
+ is(
+ $make_eval_text->($tokens), 'my $result;
+
+$result .= one
+
+$result .= two
+
+$result .= three
+
+return $result;', 'Making up the eval text'
+ );
+
+}
+
+# tokenise - does it tokenise properly
+sub test_tokenise : Test(13) {
+ my $self = shift;
+ my $class = $self->{class};
+ my $instance = $self->{instance};
+ can_ok( $class, 'tokenise' ) || return "Can't tokenise";
+ my $tokenise = \&{ $class . '::tokenise' };
+ my @input = discrete_snippets();
+
+ my $tokens = [];
+ foreach (@input) {
+ my $result = $tokenise->($_);
+ push @$tokens, @$result;
+ }
+ is(
+ $tokens->[0]->[1],
+ 'ahtmlcodebit:one, two , three ',
+ "Tokenise a single expression"
+ );
+ is( $tokens->[1]->[1], ' $pure @perl', "Tokenise a single expression" );
+ is( $tokens->[2]->[1], ' $pure @perl', "Tokenise a single expression" );
+ is( $tokens->[3]->[1], 'somehtmlsnippet', "Tokenise a single expression" );
+ is( $tokens->[4]->[1], q{random's text"!$},
+ "Tokenise a single expression" );
+
+ my $input = trial_text();
+ ok( $tokens = $tokenise->($input), "Run tokenise" );
+
+ is( $tokens->[0]->[1], '<some text> ', "Tokenising a block of text" );
+ is( $tokens->[1]->[1], 'htmlcode:one', "Tokenising a block of text" );
+ is( $tokens->[2]->[1], "\nsome more text ", "Tokenising a block of text" );
+ is( $tokens->[3]->[1], ' &then some @perl ', "Tokenising a block of text" );
+ is( $tokens->[4]->[1], " finally\n ", "Tokenising a block of text" );
+ is( $tokens->[5]->[1], 'asnippet', "Tokenising a block of text" );
+
+}
+
+sub discrete_snippets {
+
+ (
+ '[{ahtmlcodebit:one, two , three }]',
+ '[% $pure @perl%]',
+ '[" $pure @perl"]',
+ '[<somehtmlsnippet>]',
+ q{random's text"!$},
+ )
+
+}
+
+
+sub test_tokens_to_perl : Test(12) {
+ my $self = shift;
+ my $class = $self->{class};
+ my $instance = $self->{instance};
+
+ can_ok( $class, 'tokens_to_perl' ) || return;
+ my @snippets = discrete_snippets();
+ my $tokenise = \&{ $class . '::tokenise' };
+ my $code_up_tokens = \&{ $class . '::tokens_to_perl' };
+
+ my $tokens = [];
+ foreach (@snippets) {
+ my $toke;
+ ok( $toke = $tokenise->($_) );
+ push @$tokens, @$toke;
+ }
+
+ my $tokens = $code_up_tokens->($tokens, sub {} );
+ is( ref $tokens, 'ARRAY', "tokens_to_perl tokens returns an array ref." );
+ my @encoded = @$tokens;
+ is(
+ $encoded[0]->[1],
+ q! eval { ahtmlcodebit('one', 'two', 'three') } || '';! . "\n",
+ "Encoding HTMLCODE"
+ );
+ is(
+ $encoded[1]->[1],
+ qq! eval { \n \$pure \@perl\n} || '';\n!,
+ "Encoding PERL"
+ );
+ is(
+ $encoded[2]->[1],
+ qq! eval { \n \$pure \@perl\n} || '';\n!,
+ "Encoding PERL"
+ );
+ is(
+ $encoded[3]->[1],
+ qq! eval {htmlsnippet('somehtmlsnippet')} || '';\n!,
+ "Encoding HTMLSNIPPET"
+ );
+ is( $encoded[4]->[1], q{ 'random\'s text"!$';}, "Encoding TEXT" );
+}
+
+sub test_add_error_text : Test(8) {
+ my $self = shift;
+ my $class = $self->{class};
+ my $instance = $self->{instance};
+
+ can_ok( $class, 'add_error_text' ) || return;
+ my $add_error_text = \&{ $class . '::add_error_text' };
+ my $error_code =
+qr/\s*Everything::logErrors\('',\s+ \$@,\s+ '',\s+ \{\s+ title\s+ =>\s* 'Fake\\\sNode',\s+node_id\s+ =>\s+ '222'\s+ \}\)\s*if\s+\(\$@\);
+/sx;
+ my $current_node = { title => 'Fake Node', node_id => 222 };
+ ### set up our encoded text
+ my @snippets = discrete_snippets();
+
+ my $tokenise = \&{ $class . '::tokenise' };
+ my @tokens = ();
+ foreach (@snippets) {
+ my $toke;
+ ok( $toke = $tokenise->($_) );
+ push @tokens, @$toke;
+ }
+
+ my $code_up_tokens = \&{ $class . '::tokens_to_perl' };
+ my $encoded_tokens = $code_up_tokens->( \@tokens );
+ is( ref $encoded_tokens, 'ARRAY', "Code up tokens returns an array ref." );
+ my $error_text = $add_error_text->( $current_node );
+ like( $error_text, qr/Everything::logErrors/, "Add error text works" );
+
+}
+
+sub trial_text {
+
+ q/<some text> [{htmlcode:one}]
+some more text [% &then some @perl %] finally
+ [<asnippet>] and Title:[{morehtmlcode}]/
+
+}
+
+1;
+
Property changes on: trunk/ebase/lib/Everything/Node/Test/Parseable.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/lib/Everything/Node/Test/Runnable.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Test/Runnable.pm (rev 0)
+++ trunk/ebase/lib/Everything/Node/Test/Runnable.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -0,0 +1,113 @@
+package Everything::Node::Test::Runnable;
+
+use strict;
+use base 'Test::Class';
+use Test::More;
+use Test::MockObject;
+use Test::MockObject::Extends;
+use Test::Exception;
+use Scalar::Util 'blessed';
+
+
+
+
+
+
+
+sub startup_runnable : Test(startup => 1) {
+ my $self = shift;
+ my $mock = Test::MockObject->new;
+ $mock->fake_module('Everything',
+ flushErrorsToBackside => sub {1},
+ getBacksideErrors => sub {1});
+
+ $mock->fake_module('Everything::Auth');
+ *Everything::HTTP::Request::DB = \$mock;
+ $mock->set_always('get_db', $mock);
+ $mock->set_always('getNodeById', $mock);
+
+ $mock->set_always('getNode', $mock);
+ $mock->set_always('get_user', $mock);
+ $mock->set_always('get_db', $mock);
+
+
+
+
+ $mock->set_true('update');
+ $mock->set_true('setVars');
+ $mock->set_series('isGod', 0, 1);
+
+ $mock->set_always('param', $mock);
+
+ $self->{mock} = $mock;
+
+ *Everything::HTML::Code::Environment::flushErrorsToBackside = sub {1};
+ *Everything::HTML::Code::Environment::clearFrontside = sub {1};
+ *Everything::HTML::Code::Environment::getFrontsideErrors = sub {[]};
+
+ my $class = $self->module_class();
+
+ $self->{class} = $class;
+ use Everything;
+ use_ok($class) or die;
+
+
+}
+
+
+sub module_class
+{
+ my $self = shift;
+ my $name = blessed( $self );
+ $name =~ s/Test:://;
+ return $name;
+}
+
+
+sub fixture_environment : Test(setup) {
+ my $self=shift;
+ $self->{instance} = $self->{class}->new;
+
+
+}
+
+
+### A utility sub for eval
+sub test_createAnonSub : Test(2) {
+ my $self = shift;
+ can_ok($self->{class}, 'createAnonSub') || return;
+ my $arg = "some random data";
+ like( $self->{instance}->createAnonSub($arg), qr/^\s*sub\s*\{\s*$arg\s*\}/s, 'createAnonSub wraps args in sub{}');
+}
+
+
+
+## takes text which should be an eval-able sub as an argument, returns
+## a string.
+sub test_eval_code : Test(4) {
+ my $self = shift;
+ my $class = $self->{class};
+ my $instance = $self->{instance};
+ can_ok($class, 'eval_code');
+
+
+ my $errors = '';
+
+ local *Everything::HTML::flushErrorsToBackside;
+ *Everything::HTML::flushErrorsToBackside = sub { 1 };
+
+
+ local *Everything::HTML::getFrontsideErrors;
+ *Everything::HTML::getFrontsideErrors = sub { [] };
+
+ local *Everything::HTML::logErrors;
+ *Everything::HTML::logErrors = sub { $errors = "@_" };
+
+ my $code = eval "sub {'random text'}";
+ is (ref $code, 'CODE', '...we get a code ref.');
+ is($instance->eval_code($code, 'page'), 'random text', 'Eval code works');
+ is ($errors, '', '...runs without errors.') || diag $errors;
+}
+
+1;
+
Property changes on: trunk/ebase/lib/Everything/Node/Test/Runnable.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Modified: trunk/ebase/lib/Everything/Node/Test/htmlpage.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Test/htmlpage.pm 2007-05-22 23:13:06 UTC (rev 959)
+++ trunk/ebase/lib/Everything/Node/Test/htmlpage.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -19,41 +19,6 @@
'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' )
- ->clear();
- $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;
Modified: trunk/ebase/lib/Everything/Node/container.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/container.pm 2007-05-22 23:13:06 UTC (rev 959)
+++ trunk/ebase/lib/Everything/Node/container.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -11,7 +11,7 @@
use strict;
use warnings;
-use base 'Everything::Node::node';
+use base 'Everything::Node::Parseable', 'Everything::Node::node';
=head2 C<dbtables()>
@@ -25,4 +25,8 @@
return 'container', $self->SUPER::dbtables();
}
+sub get_compilable_field {
+ 'context';
+}
+
1;
Modified: trunk/ebase/lib/Everything/Node/htmlcode.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/htmlcode.pm 2007-05-22 23:13:06 UTC (rev 959)
+++ trunk/ebase/lib/Everything/Node/htmlcode.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -11,7 +11,7 @@
use strict;
use warnings;
-use base 'Everything::Node::node';
+use base 'Everything::Node::node', 'Everything::Node::Runnable';
=head2 C<dbtables()>
@@ -59,4 +59,8 @@
return 1;
}
+sub get_compilable_field {
+ 'code';
+}
+
1;
Modified: trunk/ebase/lib/Everything/Node/htmlpage.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/htmlpage.pm 2007-05-22 23:13:06 UTC (rev 959)
+++ trunk/ebase/lib/Everything/Node/htmlpage.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -11,7 +11,7 @@
use strict;
use warnings;
-use base 'Everything::Node::node';
+use base 'Everything::Node::node', 'Everything::Node::Parseable';
=head2 C<dbtables()>
@@ -25,25 +25,8 @@
return 'htmlpage', $self->SUPER::dbtables();
}
-=head2 C<insert>
-
-We need to set up some default settings when a htmlpage is inserted.
-
-=cut
-
-sub insert
-{
- my ( $this, $USER ) = @_;
-
- # If there is no parent container set, we need a default
- unless ( $this->{parent_container} )
- {
- my $GNC =
- $this->{DB}->getNode( "general nodelet container", "container" );
- $this->{parent_container} = $GNC ? $GNC : 0;
- }
-
- $this->SUPER( $USER );
+sub get_compilable_field {
+ 'page';
}
1;
Modified: trunk/ebase/lib/Everything/Node/htmlsnippet.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/htmlsnippet.pm 2007-05-22 23:13:06 UTC (rev 959)
+++ trunk/ebase/lib/Everything/Node/htmlsnippet.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -11,6 +11,12 @@
use strict;
use warnings;
-use base 'Everything::Node::htmlcode';
+use base 'Everything::Node::Parseable', 'Everything::Node::htmlcode';
+sub get_compilable_field {
+
+ 'code'
+
+}
+
1;
Modified: trunk/ebase/lib/Everything/Node/nodegroup.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/nodegroup.pm 2007-05-22 23:13:06 UTC (rev 959)
+++ trunk/ebase/lib/Everything/Node/nodegroup.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -418,7 +418,7 @@
=back
-Returns a reference to an array of node hashes that belong to this group.
+Returns a reference to an array of node instances that belong to this group.
=cut
Modified: trunk/ebase/lib/Everything/Node/nodelet.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/nodelet.pm 2007-05-22 23:13:06 UTC (rev 959)
+++ trunk/ebase/lib/Everything/Node/nodelet.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -11,7 +11,7 @@
use strict;
use warnings;
-use base 'Everything::Node::node';
+use base 'Everything::Node::Parseable', 'Everything::Node::node';
=head2 C<dbtables()>
@@ -60,4 +60,8 @@
return $keys;
}
+sub get_compilable_field {
+ 'nlcode';
+}
+
1;
Modified: trunk/ebase/lib/Everything/Node/superdoc.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/superdoc.pm 2007-05-22 23:13:06 UTC (rev 959)
+++ trunk/ebase/lib/Everything/Node/superdoc.pm 2007-05-22 23:14:00 UTC (rev 960)
@@ -11,6 +11,8 @@
use strict;
use warnings;
-use base 'Everything::Node::document';
+use base 'Everything::Node::Parseable', 'Everything::Node::document';
+sub get_compilable_field { 'doctext' }
+
1;
Added: trunk/ebase/t/Node/parseable.t
===================================================================
--- trunk/ebase/t/Node/parseable.t (rev 0)
+++ trunk/ebase/t/Node/parseable.t 2007-05-22 23:14:00 UTC (rev 960)
@@ -0,0 +1,6 @@
+#!/usr/bin/perl
+
+use Everything::Node::Test::Parseable;
+
+use strict;
+Everything::Node::Test::Parseable->runtests;
Property changes on: trunk/ebase/t/Node/parseable.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/t/Node/runnable.t
===================================================================
--- trunk/ebase/t/Node/runnable.t (rev 0)
+++ trunk/ebase/t/Node/runnable.t 2007-05-22 23:14:00 UTC (rev 960)
@@ -0,0 +1,7 @@
+#!/usr/bin/perl -w
+
+use Everything::Node::Test::Runnable;
+
+use strict;
+
+Everything::Node::Test::Runnable->runtests;
Property changes on: trunk/ebase/t/Node/runnable.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:14:26
|
Revision: 961
http://svn.sourceforge.net/everydevel/?rev=961&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:14:25 -0700 (Tue, 22 May 2007)
Log Message:
-----------
Initial amendments to HTML.pm for new parse/run scheme
Modified Paths:
--------------
trunk/ebase/lib/Everything/HTML.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:994
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:995
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/HTML.pm
===================================================================
--- trunk/ebase/lib/Everything/HTML.pm 2007-05-22 23:14:00 UTC (rev 960)
+++ trunk/ebase/lib/Everything/HTML.pm 2007-05-22 23:14:25 UTC (rev 961)
@@ -1075,7 +1075,7 @@
my $result = eval($EVALX_CODE);
# Log any errors that we get so that we may display them later.
- logErrors( $EVALX_WARN, $@, $EVALX_CODE, $CURRENTNODE );
+ logErrors( $EVALX_WARN, $@, $EVALX_CODE, $CURRENTNODE ) if $@;
return $result;
}
@@ -1117,30 +1117,8 @@
# We can only execute this if the logged in user has execute permissions.
return undef unless ( $CODE->hasAccess( $user, 'x' ) );
- my $result;
+ return $CODE->run( undef, $HTMLVARS{noCompile}, @_ );
- # this htmlcode may have been Compil-O-Cached
- # check if we can execute the cached sub and try to do it
- unless ( ( exists( $HTMLVARS{noCompile} ) and $HTMLVARS{noCompile} )
- or exists( $CODE->{DB}->{workspace} ) )
- {
- $result = executeCachedCode( 'code', $CODE, \@_ );
- return $result if ( defined($result) );
-
- # otherwise, run it through Compil-O-Cache
- if ( $$CODE{code} )
- {
- my $code = createAnonSub( $$CODE{code} );
- $result = compileCache( $code, $CODE, 'code', \@_ );
- return $result if defined $result;
- }
- }
-
- # The reason we do not call evalXTrapErrors is because we want
- # htmlcode that is called like normal functions to fail like
- # normal function and not return some kind of bogus string that
- # they were not expecting.
- return evalX( $$CODE{code}, $CODE, @_ );
}
=cut
@@ -1212,6 +1190,43 @@
=cut
+
+=head2 C<execute_coderef>
+
+This, as the name implies executes a code ref.
+
+
+=cut
+
+sub execute_coderef {
+
+ my ( $code_ref, $field, $CURRENTNODE, $args ) = @_;
+ my $warn;
+ my $NODE = $GNODE;
+ local $SIG{__WARN__} = sub {
+ $warn .= $_[0] unless $_[0] =~ /^Use of uninitialized value/;
+ };
+
+ flushErrorsToBackside();
+
+ my $result = eval { $code_ref->( $CURRENTNODE, @$args ) } || '';
+
+ local $SIG{__WARN__} = sub { };
+
+ logErrors( $warn, $@, $$CURRENTNODE{$field}, $CURRENTNODE )
+ if $warn or $@;
+
+ my $errors = getFrontsideErrors();
+
+ if ( int(@$errors) > 0 ) {
+ $result .= htmlFormatErr( $errors, $CURRENTNODE );
+ }
+ clearFrontside();
+
+ return $result;
+
+}
+
=head2 C<executeCachedCode>
This is a supporting function for Compile-O-Cache. It attempts to execute a
@@ -1256,30 +1271,7 @@
{
if ( ref($code_ref) eq 'CODE' and defined &$code_ref )
{
- my $warn;
- my $NODE = $GNODE;
- local $SIG{__WARN__} = sub {
- $warn .= $_[0] unless $_[0] =~ /^Use of uninitialized value/;
- };
-
- flushErrorsToBackside();
-
- my $result = eval { $code_ref->( $CURRENTNODE, @$args ) } || '';
-
- local $SIG{__WARN__} = sub { };
-
- logErrors( $warn, $@, $$CURRENTNODE{$field}, $CURRENTNODE )
- if $warn or $@;
-
- my $errors = getFrontsideErrors();
-
- if ( int(@$errors) > 0 )
- {
- $result .= htmlFormatErr( $errors, $CURRENTNODE );
- }
- clearFrontside();
-
- return $result;
+ execute_coderef( $code_ref, $field, $CURRENTNODE, $args );
}
}
}
@@ -1316,7 +1308,18 @@
=cut
+=head2 C<make_coderef>
+Takes some text. Returns a code ref.
+
+=cut
+
+sub make_coderef {
+ my ( $code, $NODE ) = @_;
+ return evalX $code, $NODE;
+
+}
+
=head2 C<compileCache>
Common compilation and caching and initial calling of htmlcode and
@@ -1352,7 +1355,7 @@
{
my ( $code, $NODE, $field, $args ) = @_;
- my $code_ref = evalX $code, $NODE;
+ my $code_ref = make_coderef( $code, $NODE);
return unless $code_ref;
@@ -1422,7 +1425,7 @@
# User must have execute permissions for this to be embedded.
if ( ( defined $node ) && $node->hasAccess( $USER, "x" ) )
{
- $html = parseCode( 'code', $node );
+ $html = $node->run( 'code' );
}
return $html;
}
@@ -1902,7 +1905,7 @@
if ( ( not $currTime or not $interval )
or ( $currTime > $lastupdate + $interval ) || ( $lastupdate == 0 ) )
{
- $$NODELET{nltext} = parseCode( 'nlcode', $NODELET );
+ $$NODELET{nltext} = $NODELET->run;
$$NODELET{lastupdate} = $currTime;
if ( not $NODELET->{DB}->{workspace} )
@@ -1959,7 +1962,7 @@
# Mark this container as being "visted";
$GLOBAL{containerTrap}{ $$CONTAINER{node_id} } = 1;
- $replacetext = parseCode( 'context', $CONTAINER );
+ $replacetext = $CONTAINER->run;
$containers = $query->param('containers') || '';
# SECURITY! Right now, only gods can see the containers. When we get
@@ -2128,8 +2131,7 @@
}
}
- my $page = parseCode( 'page', $PAGE );
-
+ my $page = $PAGE->run( undef, $HTMLVARS{noCompile} );
if ( $$PAGE{parent_container} )
{
my $container = genContainer( $$PAGE{parent_container} );
@@ -3033,7 +3035,7 @@
$options->{query} = $query;
- $AUTH ||= Everything::Auth->new($options);
+ $AUTH = Everything::Auth->new($options);
( $USER, $VARS ) = $AUTH->authUser();
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:14:57
|
Revision: 962
http://svn.sourceforge.net/everydevel/?rev=962&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:14:54 -0700 (Tue, 22 May 2007)
Log Message:
-----------
Export nodeball and further checking methods for nodeball development.
Modified Paths:
--------------
trunk/ebase/lib/Everything/Storage/Nodeball.pm
trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
trunk/ebase/lib/Everything/XML/Node.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:995
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:996
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Storage/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-05-22 23:14:25 UTC (rev 961)
+++ trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-05-22 23:14:54 UTC (rev 962)
@@ -1,3 +1,10 @@
+
+=head1 Everything::Storage::Nodeball
+
+A module that manages the import and export of nodeballs to/from a nodebase.
+
+=cut
+
package Everything::Storage::Nodeball;
{
@@ -116,6 +123,8 @@
use Carp;
use IO::File;
+use File::Path ();
+use File::Temp ();
use Everything::XML qw/readTag xmlfile2node xml2node fixNodes/;
use Everything::XML::Node;
use Everything::NodeBase;
@@ -125,8 +134,10 @@
=head2 C<set_nodeball>
-Sets a nodeball file or directory
+Sets the nodeball attribute. The argument may be a file or directory. If it is a file, the file is expanded and the nodeball_dir attribute is set to the directory of the expanded nodeball.
+If the argument is a directory, the nodeball_dir is set to it.
+
=cut
sub set_nodeball {
@@ -145,13 +156,19 @@
return;
}
+=head2 C<get_nodeball>
+
+If the file attribute is set returns its value. Otherwise returns the value of nodeball_dir.
+
+=cut
+
sub get_nodeball {
my ($self) = @_;
return $self->get_file || $self->get_nodeball_dir;
}
-=head2 C<expandNodeball>
+=head2 C<expand_nodeball>
Take a tar-gziped nodeball and expand it to a dir in /tmp return the directory
@@ -467,11 +484,9 @@
=head2 C<install_xml_nodes>
-This is a method.
-
It installs nodes stored as XML in the nodeballs.
-Takes two optional arguments. The first is the path to the nodeball directory. The second is a regular expression of node paths to avoid.
+Takes an optional argument of a call back that examines each node. The call back should return true if it's a node we want or false otherwise.
Returns undef.
@@ -485,14 +500,58 @@
my $iterator = $self->make_node_iterator($select_cb);
while ( my $xmlnode = $iterator->() ) {
- xml2node( $xmlnode->get_raw_xml );
+ $self->install_xml_node( $xmlnode );
}
return;
}
+=head2 C<install_xml_node>
+It installs a node stored as XML into the the current nodebase.
+
+It takes on argument which is the Everything::XML::Node object to be
+installed.
+
+
+=cut
+
+sub install_xml_node {
+
+ my ( $self, $xmlnode ) = @_;
+ xml2node( $xmlnode->get_raw_xml );
+
+}
+
+
+=head2 C<install_nodeball_description>
+
+It installs a node representing the current nodeball, as XML, into the
+the current nodebase.
+
+Currently, this means reading from the ME file.
+
+
+=cut
+
+sub install_nodeball_description {
+
+ my ( $self ) = @_;
+
+ my $dir = $self->get_nodeball_dir;
+ my $mefile = File::Spec->catfile( $dir, 'ME' );
+ my $fh = IO::File->new ( $mefile );
+ local $/;
+ my $xml = <$fh>;
+ $fh->close;
+ my $xmlnode = Everything::XML::Node->new;
+ $xmlnode->parse_xml( $xml );
+ $self->install_xml_node( $xmlnode );
+
+}
+
+
=head2 C<install_xml_nodetype_nodes>
This is a method.
@@ -599,10 +658,40 @@
#nodeballs are not installed... but we don't
}
-=cut
+sub export_nodeball_to_directory {
+ my ( $self, $nodeball_name, $dir ) = @_;
+ my $nodeball = $self->get_nodebase->getNode( $nodeball_name, 'nodeball');
+ croak "No nodeball, $nodeball_name" unless $nodeball;
+
+ ###setup directory for export
+ $self->set_nodeball_dir( $dir || $self->get_temp_dir );
+ $self->write_node_to_nodeball( $nodeball, 'ME' ); # create ME file
+ my $group = $nodeball->selectNodegroupFlat;
+ foreach ( @$group ) {
+
+ if ( $$_{type}{title} eq 'dbtable' ) {
+ $self->write_sql_table_to_nodeball( $$_{title} );
+ }
+
+ $self->write_node_to_nodeball( $_ );
+
+ }
+
+}
+
+sub export_nodeball_to_file {
+
+ my ( $self, $nodeball_name, $filename ) = @_;
+
+ $self->export_nodeball_to_directory( $nodeball_name );
+ $self->create_nodeball_file( $nodeball_name, undef, $filename );
+
+
+}
+
=head2 C<installModules>
Copy any perl modules that exist in this nodeball to the appropriate
@@ -893,6 +982,123 @@
return \%tables;
}
+=head2 C<write_node_to_nodeball>
+
+ Writes a node to a nodeball turning it into XML in the process. Takes one argument which should be the Everything::Node object to be written to the nodeball. Takes an optional second argument which is the path (under the nodeball directory) to which the node should be written.
+
+=cut
+
+sub write_node_to_nodeball {
+ my ( $self, $node, $filepath ) = @_;
+
+
+ my $volume;
+ my $save_title;
+ my $save_dir;
+ if ( ! $filepath ) {
+ $save_title = $$node{title};
+ $save_dir = $$node{type}{title};
+ $save_dir =~ tr/ /_/;
+ $save_dir = File::Spec->catfile ('nodes', $save_dir);
+ $save_title =~ tr/ /_/;
+ $save_title =~ s/:+/-/;
+ $save_title .= '.xml';
+ $filepath = File::Spec->catfile( $save_dir, $save_title );
+ } else {
+ ( $volume, $save_dir, $save_title ) = File::Spec->splitpath( $filepath );
+ }
+
+ my $save_path = File::Spec->catfile( $self->get_nodeball_dir, $save_dir );
+ File::Path::mkpath( $save_path ) unless -d $save_path;
+ $save_path = File::Spec->catfile( $save_path, $save_title );
+ my $xml = Everything::XML::Node->new( nodebase => $self->get_nodebase, node => $node )->toXML;
+ my $fh = IO::File->new( $save_path, 'w' ) || croak "Can't open $save_path for writing, $!";
+ print $fh $xml;
+ $fh->close;
+
+}
+
+=head2 C<write_sql_table_to_nodeball>
+
+ Writes a sql create statement to a nodeball. Takes one argument which is the table name.
+
+=cut
+
+sub write_sql_table_to_nodeball {
+ my ( $self, $table_name ) = @_;
+
+ my $nb = $self->get_nodebase;
+
+ $nb->{storage} =~ /DB::(\w+)/;
+ my $storage_type = $1;
+ my $dir = $self->get_nodeball_dir;
+ $dir = File::Spec->catfile( $dir, 'tables' );
+ mkdir $dir unless -d $dir;
+ if ( $storage_type eq 'Pg' ) {
+ $dir = File::Spec->catfile( $dir, 'Pg' );
+ }
+ elsif ( $storage_type eq 'sqlite' ) {
+ $dir = File::Spec->catfile( $dir, 'SQLite' );
+ }
+ elsif ( $storage_type eq 'mysql' ) {
+ $dir = File::Spec->catfile( $dir, 'mysql' );
+ }
+ mkdir $dir unless -d $dir;
+
+ my $sql = $nb->{storage}->get_create_table($table_name);
+ my $file_name = File::Spec->catfile( $dir, "$table_name.sql" );
+
+ my $fh = IO::File->new( $file_name, 'w' )
+ or croak "Can't open $file_name for writing, $!";
+ print $fh $sql;
+ $fh->close;
+
+}
+
+
+=head2 C<create_nodeball_file>
+
+Tar-gzips a directory it -- as a nodeball
+
+=over 4
+
+=item * NODEBALL
+
+The nodeball object we are exporting
+
+=item * dir
+
+directory of stuff (optional if nodeball_dir is set).
+
+=back
+
+=cut
+
+sub create_nodeball_file
+{
+ my ( $self, $NODEBALL, $dir, $filename ) = @_;
+
+ $dir ||= $self->get_nodeball_dir;
+ my $nodeball = $self->get_nodebase->getNode( $NODEBALL, 'nodeball' );
+ my $VARS = $nodeball->getVars();
+ my $version = $$VARS{version};
+
+ if ( ! $filename) {
+
+ $filename = $$NODEBALL{title};
+ $filename =~ tr/ /_/;
+ $filename .= "-$version" if $version;
+ $filename .= ".nbz";
+ }
+
+ use Cwd;
+ my $cwd = getcwd();
+ $cwd .= '/' . $filename;
+
+ `tar -cvzf $cwd -C $dir .`;
+
+}
+
=head2 C<buildNodeballMembers>
Builds a hash of node_id-E<gt>nodeball that it belongs to. The nodeball(s)
@@ -930,6 +1136,65 @@
return \%nbmembers;
}
+=head2 C<check_nodeball_integrity>
+
+Checks the internal structure of a nodeball. Return undef if everything is OK.
+
+Otherwise, it returns a list of two array refs of hash refs. The hash refs have two keys 'title' and 'type'. The first hashref lists the nodes present in the nodeball but not listed in the ME file. The second lists those listed in the ME file, but not present in the nodeball.
+
+=cut
+
+sub check_nodeball_integrity {
+ my $self = shift;
+ local $/;
+ my $fh = IO::File->new( File::Spec->catfile ( $self->get_nodeball_dir, 'ME' ) );
+ my $xml = <$fh>;
+ my $me = Everything::XML::Node->new;
+ $me->parse_xml( $xml );
+ my @members = @{ $me->get_group_members || [] };
+
+ my $iterator = $self->make_node_iterator;
+ my @nodes;
+ while ( my $xmlnode = $iterator->() ) {
+ push @nodes, $xmlnode;
+ }
+
+ my ( @not_in_me, @not_in_nodeball );
+
+ foreach my $member (@members) {
+ my ( $member_type ) = split /,/, $member->get_type_nodetype;
+ my $found_xmlnode = 0;
+ XMLNODE:
+ foreach my $xmlnode ( @nodes ) {
+
+ if ( ($xmlnode->get_title eq $member->get_name) && ( $xmlnode->get_nodetype eq $member_type)) {
+ $found_xmlnode++;
+ last XMLNODE
+ }
+ }
+ push @not_in_nodeball, { title => $member->get_name, type=> $member_type } unless $found_xmlnode;
+ }
+
+
+ foreach my $xmlnode (@nodes) {
+ my $found_xmlnode = 0;
+ GROUPMEMBER:
+ foreach my $member ( @members ) {
+ my ( $member_type ) = split /,/, $member->get_type_nodetype;
+ if ( ($xmlnode->get_title eq $member->get_name) && ( $xmlnode->get_nodetype eq $member_type ) ) {
+ $found_xmlnode++;
+ last GROUPMEMBER
+ }
+
+ }
+ push @not_in_me, { title => $xmlnode->get_title, type=> $xmlnode->get_nodetype } unless $found_xmlnode;
+
+ }
+
+ return if ( ! @not_in_nodeball && ! @not_in_me );
+ return \@not_in_me, \@not_in_nodeball;
+}
+
package Everything::Storage::Nodeball::SQLParser;
use base 'SQL::Parser';
Modified: trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-05-22 23:14:25 UTC (rev 961)
+++ trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-05-22 23:14:54 UTC (rev 962)
@@ -101,7 +101,8 @@
my $mock = Test::MockObject->new;
my $fh = File::Temp->new( UNLINK => 1 );
- $mock->fake_module( 'IO::File', 'new', sub { $fh } );
+ local *IO::File::new;
+ *IO::File::new = sub { $fh };
$mock->set_always( readline => 'some xml' );
my @readTag_r = qw/version author description title/;
my @readTag_a;
@@ -125,7 +126,8 @@
# test exception throwing.
my $dir = "/some/path";
- $mock->fake_module( 'IO::File', 'new', sub { } );
+ local *IO::File::new;
+ *IO::File::new = sub { };
throws_ok { $instance->nodeball_vars($dir) }
'Everything::Exception::CorruptNodeball',
"...if can't open ME file throws an error";
@@ -468,9 +470,28 @@
ok( !-e $tempdir, '..temp directory shouldn\'t exist.' );
}
-sub test_update_nodeball : Test(6) {
+sub test_install_xml_node : Test(1) {
my $self = shift;
+ my $instance = $self->{instance};
+ my $mock = Test::MockObject->new;
+ $mock->set_always( get_raw_xml => 'some xml' );
+
+ my @xml2node_args = ();
+ no strict 'refs';
+ local *{ $self->{class} . '::xml2node' };
+ *{ $self->{class} . '::xml2node' } = sub { push @xml2node_args, $_[0] };
+ use strict 'refs';
+
+ $instance->install_xml_node( $mock );
+ is_deeply( \@xml2node_args, [ 'some xml' ], '...calls xml2node with with xml.');
+
+
+}
+
+sub test_update_nodebase_from_nodeball : Test(6) {
+ my $self = shift;
+
can_ok( $self->{class}, 'update_nodeball' )
|| return 'update_nodeball not implemented.';
my $instance = $self->{instance};
@@ -532,8 +553,7 @@
);
$rv = $test_code->( [qw/mail node/], $dir, $mock );
- use Data::Dumper;
- print Dumper $rv;
+
is_deeply( $rv, undef, '...returns undef if tables are the same.' );
rmtree $dir;
@@ -577,6 +597,13 @@
local $TODO = "Methods to export a nodeball stored in a nodebase.";
can_ok( $self->{class}, 'export_nodeball' );
+
+ my @toXMLReturns = ('me file contents', 'data');
+
+ local *Everything::XML::Node;
+ *Everything::XML::Node::toXML = sub { shift @toXMLReturns };
+
+ ### calls update_nodeball_from_nodebase;
ok( undef, '.... read nodeball data.' );
ok( undef, '....create ME file and put nodeball data into it.' );
@@ -642,6 +669,255 @@
}
+sub test_write_sql_table_to_nodeball : Test(3) {
+
+ my $self = shift;
+
+ return unless can_ok( $self->{class}, 'write_sql_table_to_nodeball' );
+
+ my $instance = $self->{instance};
+ my $mock = $self->{mock};
+
+ use Everything::DB::sqlite;
+ $mock->{storage} = Everything::DB::sqlite->new;
+
+ my @get_create_table_args;
+ local *Everything::DB::sqlite::get_create_table;
+ *Everything::DB::sqlite::get_create_table =
+ sub { push @get_create_table_args, $_[1]; return 'create statement' };
+
+ my $tempdir = get_temp_dir();
+ mkdir $tempdir;
+ $instance->set_nodebase($mock);
+ $instance->set_nodeball_dir($tempdir);
+
+ my $rv = $instance->write_sql_table_to_nodeball('atable');
+
+ is( $get_create_table_args[0],
+ "atable", '...asks for table passed as argument.' );
+ my $file =
+ File::Spec->catfile( $instance->get_nodeball_dir, 'tables', 'SQLite',
+ 'atable.sql' );
+ my $fh = IO::File->new($file) || die "Can't open $file, $!";
+ local $/;
+ my $sql = <$fh>;
+ close $fh;
+ is(
+ $sql,
+ 'create statement',
+ '...writes the create statement to an appropriately named file'
+ );
+
+}
+
+
+sub test_write_node_to_nodeball :Test(3) {
+
+ my $self = shift;
+ my $instance = $self->{instance};
+ my $mock = $self->{mock};
+
+ return unless can_ok( $self->{class}, 'write_node_to_nodeball');
+
+ local *Everything::XML::Node::new;
+ *Everything::XML::Node::new = sub { $mock };
+ $mock->set_always( 'toXML' => 'some xml' );
+
+ $mock->{ title } = 'a node title';
+ $mock->{ type } = { title => 'a node type title' };
+
+ $instance->set_nodeball_dir( get_temp_dir() );
+
+ ## a node object is passed as the argument
+ my $rv = $instance->write_node_to_nodeball( $mock );
+
+ ( my $title = $$mock{title} ) =~ s/\s/_/g;
+ my $dir = $$mock{type}{title};
+ $dir =~ s/\s/_/g;
+ $title .= '.xml';
+ my $file = File::Spec->catfile( $instance->get_nodeball_dir , 'nodes', $dir, $title );
+ my $fh = IO::File->new( $file ) || die "Can't open file, $file, $!";
+ local $/;
+ my $sql = <$fh>;
+ close $fh;
+
+ is ( $sql, 'some xml', '...writes the XML to the selected file.');
+
+ ### Now with our own filepath
+ $rv = $instance->write_node_to_nodeball( $mock, 'filepath' );
+ $fh = IO::File->new( File::Spec->catfile( $instance->get_nodeball_dir , 'filepath' ));
+
+ $sql = <$fh>;
+ close $fh;
+ is ( $sql, 'some xml', '...writes the XML to the filename of our choosing.');
+
+}
+
+sub test_create_nodeball : Test(2) {
+ return "Uses untestable backticks";
+ my $self = shift;
+ can_ok( $self->{class}, 'createNodeball' )
+ || return 'createNodeball not implemented.';
+ my $instance = $self->{instance};
+ my $mock = $self->{mock};
+ $mock->{title} = 'a nodeball';
+ my $test_code = \&{ $self->{class} . '::createNodeball' };
+
+ my $tmpdir = get_temp_dir();
+ no strict 'refs';
+ local *{ $self->{class} . '::getcwd' };
+ *{ $self->{class} . '::getcwd' } = sub { File::Spec->tmpdir };
+ use strict 'refs';
+
+ $mock->set_always( 'getVars', { a => 1, b => 2 } );
+
+ mkdir $tmpdir;
+ my $printed;
+ my $in = 'y';
+
+ {
+ local *STDOUT; # stop the noise;
+ $test_code->( $tmpdir, $mock );
+ }
+ ok(
+ -e File::Spec->tmpdir . "/a_nodeball.nbz",
+ '..nodeball file should be created.'
+ );
+ $self->{nodeball_file} = File::Spec->tmpdir . "/a_nodeball.nbz";
+ rmdir $tmpdir;
+}
+
+sub test_update_nodeball_from_nodebase :Test(6) {
+ local $TODO = 'Unimplemented.';
+ my $self = shift;
+
+ #### does almost everything by called write_node_to_nodeball
+
+ can_ok( $self->{class}, 'update_nodeball_from_nodebase' ) || return "Unimplemented";
+
+ local *Everything::XML::Node;
+ *Everything::XML::Node::toXML = sub { 'some xml' };
+
+ ok( undef, '...create new ME file.');
+
+ ok( undef, '...replace new ME file with old one.');
+
+ ok( undef, '...remove dbtables not in new ME file.');
+
+ ok( undef, '...remove nodes not in new ME file.');
+
+ ok( undef, '...run through nodeball members with modified dates greater than createtime (of nodeball) and save them.');
+
+}
+
+sub test_check_nodeball_against_nodebase :Test(1) {
+ local $TODO = "Unimplemented";
+
+ ok( undef, '...runs through each node in the nodeball and checks for type, attributes and values against the node stored in the nodebase.');
+
+
+}
+
+sub test_check_nodebase_against_nodeball :Test(1) {
+ local $TODO = "Unimplemented";
+
+ ok( undef, '...runs through each node in the nodebase and checks for type, attributes and values against the xmlnode stored in the nodeball.');
+
+
+}
+
+sub test_check_nodeball_integrity :Test(4) {
+
+ my $self = shift;
+ my $instance = $self->{instance};
+
+ my $dir = get_temp_dir();
+ mkdir $dir;
+
+ $instance->set_nodeball_dir( $dir );
+
+ my $mefile = File::Spec->catfile ($dir, 'ME');
+ my $fh = IO::File->new;
+ $fh->open( $mefile, 'w' ) || die "Can't open $mefile, $!";
+ print $fh <<HERE;
+<NODE export_version="0.5" nodetype="nodeball" title="core system">
+ <group>
+ <member name="group_node" type="noderef" type_nodetype="theme,nodetype">default theme</member>
+ <member name="group_node" type="noderef" type_nodetype="superdoc,nodetype">Create a new user</member>
+ <member name="group_node" type="noderef" type_nodetype="superdoc,nodetype">Duplicates Found</member>
+</group>
+</NODE>
+HERE
+ $fh->close;
+ my $one = Everything::XML::Node->new;
+ $one->set_title('Create a new user');
+ $one->set_nodetype( 'htmlcode' );
+
+ my $two = Everything::XML::Node->new;
+ $two->set_title('thingo');
+ $two->set_nodetype( 'thingotype' );
+
+ my $three = Everything::XML::Node->new;
+ $three->set_title('default theme');
+ $three->set_nodetype( 'theme' );
+
+ my @xmlnodes = ( $one, $two, $three );
+ no strict 'refs';
+ local *{ $self->{class} . '::make_node_iterator' };
+ *{ $self->{class} . '::make_node_iterator' } = sub { sub { shift @xmlnodes }};
+ use strict 'refs';
+
+ my ($not_in_ME, $not_in_nodeball) = $instance->check_nodeball_integrity;
+ use Data::Dumper; diag Dumper $not_in_ME, $not_in_nodeball;
+ my @sorted = sort { $a->{title} cmp $b->{title} } @$not_in_ME;
+ is($sorted[0]->{title}, 'Create a new user', '...not in ME when titles same but types are different.');
+ is($sorted[1]->{title}, 'thingo', '...not in ME when title not presnet.');
+
+ @sorted = sort { $a->{title} cmp $b->{title} } @$not_in_nodeball;
+ is($sorted[0]->{title}, 'Create a new user', '...not in nodeball when titles same but types are different.');
+ is($sorted[1]->{title}, 'Duplicates Found', '...not in nodeball when title not presnet.');
+
+
+}
+
+sub test_check_nodeball_presence :Test(4) {
+ local $TODO = "Unimplemented.";
+
+ my $self = shift;
+ my $instance = $self->{instance};
+ return "unimplemented";
+ my $dir = get_temp_dir();
+ mkdir $dir;
+ my $mock = Test::MockObject->new;
+ $instance->set_nodebase( $mock );
+ $mock->set_always( selectNodegroupFlat => [ { title => "Duplicate Found", type => { title => 'superdoc' }}, { title => "Create a new user", type => { title => 'htmlcode' }}, { title => "thingo", type => { title => 'thingtype' }} ] );
+
+ $instance->set_nodeball_dir( $dir );
+
+ my $mefile = File::Spec->catfile ($dir, 'ME');
+ my $fh = IO::File->new( $mefile, 'w' ) || die "Can't open $mefile, $!";
+ print $fh <<HERE;
+<NODE export_version="0.5" nodetype="nodeball" title="core system">
+ <group>
+ <member name="group_node" type="noderef" type_nodetype="theme,nodetype">default theme</member>
+ <member name="group_node" type="noderef" type_nodetype="superdoc,nodetype">Create a new user</member>
+ <member name="group_node" type="noderef" type_nodetype="superdoc,nodetype">Duplicates Found</member>
+</group>
+</NODE>
+HERE
+
+ my ($not_in_nodebase, $not_in_nodeball) = $instance->check_nodeball_integrity;
+ my @sorted = sort { $a->get_title cmp $b->get_title } @{ $not_in_nodebase || [] };
+ is($sorted[0]->get_title, 'Create a new user', '...not in nodebase when titles same but types are different.');
+ is($sorted[1]->get_title, 'default theme', '...not in nodebase when title not presnet.');
+
+ @sorted = sort { $a->{title} cmp $b->{title} } @{ $not_in_nodeball || [] };
+ is($sorted[0]->get_title, 'Create a new user', '...not in nodeball when titles same but types are different.');
+ is($sorted[1]->get_title, 'default theme', '...not in nodeball when title not presnet.');
+
+
+}
+
sub parse_sql_file_returns {
(
Modified: trunk/ebase/lib/Everything/XML/Node.pm
===================================================================
--- trunk/ebase/lib/Everything/XML/Node.pm 2007-05-22 23:14:25 UTC (rev 961)
+++ trunk/ebase/lib/Everything/XML/Node.pm 2007-05-22 23:14:54 UTC (rev 962)
@@ -267,7 +267,7 @@
unless ( $REF->isOfType( $type, 1 ) )
{
- Everything::logErrors( "Field '$fieldname' needs a node of type "
+ Everything::logErrors( "$doc Field '$fieldname' needs a node of type "
. "'$type',\nbut it is pointing to a node of type "
. "'$REF->{type}{title}'!" );
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-05-22 23:15:54
|
Revision: 964
http://svn.sourceforge.net/everydevel/?rev=964&view=rev
Author: paul_the_nomad
Date: 2007-05-22 16:15:52 -0700 (Tue, 22 May 2007)
Log Message:
-----------
HTML tests for an everything installation
Added Paths:
-----------
trunk/ebase/bin/html-server-test.pl
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:997
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:998
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Added: trunk/ebase/bin/html-server-test.pl
===================================================================
--- trunk/ebase/bin/html-server-test.pl (rev 0)
+++ trunk/ebase/bin/html-server-test.pl 2007-05-22 23:15:52 UTC (rev 964)
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Carp qw/croak confess cluck/;
+use Everything::CmdLine qw/abs_path get_options make_nodebase/;
+use Everything::Test::Ecore::SimpleServer;
+use Test::More;
+use WWW::Mechanize;
+use HTML::Lint;
+
+$SIG{__DIE__} =\&confess;
+#$SIG{__WARN__} =\&cluck;
+
+$|++;
+
+my $opts = get_options( undef, [ 'listenport=i'] );
+my $nb = make_nodebase( $opts );
+
+my $nodes = $nb->getNodeWhere();
+
+my $num_nodes = scalar @$nodes;
+
+plan tests => $num_nodes * 2;
+
+$$opts{type} ||= 'sqlite';
+$$opts{listenport} ||= 8080;
+
+my $server = Everything::Test::Ecore::SimpleServer->new( { mod_perlInit => ["$$opts{database}:$$opts{user}:$$opts{password}:$$opts{host}", { dbtype => $$opts{type}} ], listenport => $$opts{'listenport'} } );
+
+my $pid = $server->background;
+
+croak "Server won't start" unless $pid;
+
+my $base_url = "http://localhost:$$opts{'listenport'}";
+
+my $mech = WWW::Mechanize->new;
+
+for (1..$num_nodes) {
+ my $url = $base_url . "?node_id=$_";
+ my $r = $mech->get ( $url );
+ my $lint = HTML::Lint->new;
+ ok ($r->is_success, "...successfully retrieved node id $_.") || diag "Error fetching $url\n" . $r->status_line;
+ $lint->parse( $r->content );
+ is( scalar $lint->errors, 0, "...the HTML produced for node id $_ has no errors.")
+ ||
+ do {
+ diag $_->as_string foreach $lint->errors;
+ diag $r->content;
+ exit;
+ };
+}
+
+kill 9, $pid;
Property changes on: trunk/ebase/bin/html-server-test.pl
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-06-06 10:01:06
|
Revision: 965
http://svn.sourceforge.net/everydevel/?rev=965&view=rev
Author: paul_the_nomad
Date: 2007-06-06 03:01:02 -0700 (Wed, 06 Jun 2007)
Log Message:
-----------
Compare nodeball to nodebase code and tests
Modified Paths:
--------------
trunk/ebase/lib/Everything/Storage/Nodeball.pm
trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:998
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1014
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Storage/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-05-22 23:15:52 UTC (rev 964)
+++ trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-06-06 10:01:02 UTC (rev 965)
@@ -741,129 +741,330 @@
return $result;
}
-=cut
-=head2 C<update_nodeball>
+sub build_new_nodes {
-We already have this nodeball in the system, and we need to figure out which
-files to add, remove, and update.
+ my ( $self ) = @_;
+ my $select_cb ||= sub { 1 };
+ my $iterator = $self->make_node_iterator();
+
+ my @nodes;
+ while ( my $xmlnode = $iterator->() ) {
+ my $node = xml2node( $xmlnode->get_raw_xml, 'nofinal' );
+ print "@$node\n";
+ push @nodes, @$node;
+ }
+
+ return @nodes;
+
+}
+
+sub get_conflicting_nodes {
+ my ( $self ) = @_;
+
+
+}
+
+sub update_node_to_nodebase {
+ my ( $self, $node, $handle_conflict_cb ) = @_;
+
+ my $oldnode = $node->existingNodeMatches();
+
+ ## default behaviour is to clobber nodes
+ $handle_conflict_cb ||= sub{ $oldnode->updateFromImport( $node, -1 ) };
+
+ if ( $oldnode->conflictsWith( $node ) ){
+ $handle_conflict_cb->();
+ } else {
+ $oldnode->updateFromImport( $node, -1 );
+ }
+
+
+
+}
+
+
+
+=head2 C<verify_nodes>
+
+Cycles through the nodeball and checks each node against what is in the nodebase. the Checks that a node in the nodeball is the same as the one in the nodebase.
+Returns an array ref of array refs.
+
+Each of the inner array refs are as follows:
+
+If the node is in the nodeball but not in the nodebase:
+
+[ $xmlnode, undef ]
+
+If the node is in the nodebase (and listed as a member of the nodeball), but not in the nodeball:
+
+[ undef, $node ]
+
+If the node is in the nodebase and nodeball, but there are differences:
+
+[ $xmlnode, $diff_hash ]
+
+$diff_hash is a hash of the difference as returned by verify_node().
+
=cut
-sub update_nodeball {
- my ( $self, $OLDBALL, $dir ) = @_;
- my $DB = $self->get_nodebase
- || Everything::Exception::NoNodeBase->throw("No nodebase here!");
- $dir ||= $self->get_nodeball_dir;
- my $NEWBALL = $self->nodeball_xml;
+sub verify_nodes {
+ my ( $self ) = @_;
- my $script_dir = $dir . "/scripts";
- my $preinst = $script_dir . "/preupdate.pl";
- require $preinst if -f $preinst;
+ my $nb = $self->get_nodebase;
- #check the tables and make sure that they're compatable
+ my $iterator = $self->make_node_iterator;
- $self->insert_sql_tables($dir);
+ my @diffs;
- my $nodesdir = $dir . "/nodes";
- my @nodes = ();
- my @conflictnodes = ();
+ my $nodebase_nodeball_group = $nb->getNode( $self->nodeball_vars->{title}, 'nodeball')->selectGroupArray;
- use File::Find;
+ ## get nodes in group;
- # XXX: for this to work we need to split XML::xml2node so that
- # inserting into the database and creating functions from nodes
- # are not going through the same function
+ my %nodebase_group = map { my $n = $nb->getNode( $_ );
+ ("$$n{title},$$n{type}{title}" => 1);
+ }
+ @$nodebase_nodeball_group;
- # XXXX: xmlFinal also calls update
- find sub {
- my $file = $File::Find::name;
- return unless $file =~ /\.xml$/;
- ## no final means we don't insert the node into the db.
- my $info = xmlfile2node( $file, 'nofinal' );
- push @nodes, @$info if $info;
- }, $nodesdir;
+ XMLNODE:
+ while (my $xmlnode = $iterator->() ) {
- #check to make sure all dependencies are installed
+ my $title = $xmlnode->get_title;
+ my $type = $xmlnode->get_nodetype;
+ my $node = $self->get_nodebase->getNode( $title, $type );
- # create a hash of the old nodegroup -- better lookup times
- my (%oldgroup);
- foreach my $id ( @{ $$OLDBALL{group} } ) {
- $oldgroup{$id} = $DB->getNode($id);
+ delete $nodebase_group{ "$title,$type" };
+
+ if ( ! $node) {
+
+ push @diffs, [ $xmlnode, undef ];
+ next XMLNODE;
+ }
+
+ if ( my $diff = $self->verify_node( $xmlnode, $node) ) {
+
+ push @diffs, [ $xmlnode, $diff ];
+ next XMLNODE;
+ }
+
}
- ### get all the old noball members.
- my $nbmembers = buildNodeballMembers($OLDBALL);
- my $new_nbfile;
- foreach my $node_id (@nodes) {
- my $N = $DB->getNode($node_id);
- next
- if $$N{type}{title} eq 'nodeball'
- and $$N{title} eq $$NEWBALL{title};
+ foreach ( keys %nodebase_group ) {
+ my ( $title, $type ) = split /,/, $_;
+ push @diffs, [ undef, $nb->getNode( $title, $type ) ];
+ }
- # XXX: According to Node.pm, this is supposed to get called on
- # a dummy node, but here we're calling it on a node retrieved
- # from the DB. Something won't work.
+ return \@diffs;
+}
- my $OLDNODE = $N->existingNodeMatches();
- if ($OLDNODE) {
- next if $$N{type}{title} eq 'nodeball';
- if ( $oldgroup{ $OLDNODE->getId() } ) {
- delete $oldgroup{ $OLDNODE->getId() };
+=head2 C<verify_node>
+
+Checks that a node in the nodeball is the same as the one in the nodebase.
+
+First argument in the XML::Node object, the second one is the Everything::Node object.
+
+Returns a hash ref of differences. It has the the following structure.
+
+{
+
+ attribute => { attributename => [ $xmlnode, $node, $attributetype ],
+ attributename2 => [ $xmlnode, $node, 'noderef', $referenced_node ],
+ ....
+ },
+
+ var => { varname => [ $xmlnode, $node, 'literal_value' ],
+ varname2 => [ $xmlnode, $node, 'noderef', $referenced_node ],
+ ....
+ },
+
+
+ groupmember => { membernodetype,nodetype => [ $xmlnode, $node, $referenced_node ],
+ ....
+ }
+
+}
+
+=cut
+
+## Arguably, the return value is a little confusing and difficult to
+## unpack, so we should do itwith an Everything::Nodeball::Difference
+## object or something
+
+
+sub verify_node {
+
+ my ( $self, $xmlnode, $node ) = @_;
+
+
+ ### XXX: if we want to turn this into a function, $nb can be the
+ ### nodebae stored in $node
+ my $nb = $self->get_nodebase;
+
+ my %differences;
+ ## verify attributes
+ my $atts = $xmlnode->get_attributes;
+
+
+
+ my $node_title = $xmlnode->get_title;
+ my $node_type = $xmlnode->get_nodetype;
+
+ my %attribute_differences;
+
+ foreach (@$atts) {
+ my $att_name = $_->get_name;
+
+ my $att_type = $_->get_type;
+
+ if ( $att_type eq 'literal_value' ) {
+
+ ## the line below makes undef an empty string to deal
+ ## with the way database tables are created at the
+ ## moment.
+ my $content = defined $_->get_content ? $_->get_content : '';
+
+ unless ( $node->{$att_name} eq $content ) {
+ $attribute_differences{ $att_name } = [ $xmlnode, $node, $att_type ];
+ }
+
}
+ else {
- if ( $$nbmembers{ $OLDNODE->getId() } ) {
- my $OTHERNB = $DB->getNode( $$nbmembers{ $OLDNODE->getId() } );
- next
- unless confirmYN(
-"$$OLDNODE{title} ($$OLDNODE{type}{title}) is also included in the \"$$OTHERNB{title}\" nodeball. Do you want to replace it (N/y)?"
- );
+ my ($type_name) = split /,/, $_->get_type_nodetype;
+ my $node_name = $_->get_content;
+
+ my $wanted = $nb->getNode( $node_name, $type_name );
+
+ unless ( $node->{$att_name} == $wanted->{node_id} ) {
+ $attribute_differences{ $att_name } = [ $xmlnode, $node, $att_type, $wanted ];
+ }
+
}
- if ( not $OLDNODE->conflictsWith($N) ) {
- $OLDNODE->updateFromImport( $N, -1 );
+ $differences{ attributes } = \%attribute_differences if %attribute_differences;
+ }
+
+
+ ### verify vars
+
+ my $vars = $xmlnode->get_vars;
+
+ if (@$vars) {
+
+ my $db_vars = $node->getVars;
+
+ my %var_differences;
+
+ foreach (@$vars) {
+
+ my $var_name = $_->get_name;
+
+ my $var_type = $_->get_type;
+
+
+ if ( $var_type eq 'literal_value' ) {
+
+ ## the line below makes undef an empty string to deal
+ ## with the way database tables are created at the
+ ## moment.
+ my $content = defined $_->get_content ? $_->get_content : '';
+
+
+ unless ( $db_vars->{$var_name} eq $content ) {
+ $var_differences{ $var_name } = [ $xmlnode, $node, $var_type ];
+ }
+
}
else {
- push @conflictnodes, $N;
+
+ my ($type_name) = split /,/, $_->get_type_nodetype;
+ my $node_name = $_->get_content;
+
+ my $wanted = $nb->getNode( $node_name, $type_name );
+
+ unless ( $db_vars->{$var_name} == $wanted->{node_id} ) {
+ $var_differences{ $var_name } = [ $xmlnode, $node, $var_type, $wanted ];
+ }
+
+
}
}
- else {
- if ( $$N{type}{title} eq 'nodeball' ) {
- print
-"shoot! Your nodeball says it needs $$N{title}. You need to go get that.";
- die unless $self->FORCE;
- }
- $N->xmlFinal();
- }
+ $differences{ vars } = \%var_differences if %var_differences;
+
+
}
+ ## verify group members
- fixNodes(0);
- #fix broken dependancies
+ my $members = $xmlnode->get_group_members;
- handleConflicts( \@conflictnodes, $NEWBALL );
+ if ( @$members ) {
+
+ my %db_members = map { $_ => 1 } @{ $node->selectGroupArray };
- #insert the new nodeball
- $OLDBALL->updateFromImport( $NEWBALL, -1 );
+ my %member_differences;
- #find the unused nodes and remove them
- foreach ( values %oldgroup ) {
- my $NODE = $DB->getNode($_);
+ foreach (@$members) {
- next unless ($NODE);
+ my ($type_name) = split /,/, $_->get_type_nodetype;
+ my $node_name = $_->get_name;
- #we should probably confirm this
- #$NODE->nuke(-1);
+ my $wanted = $nb->getNode( $node_name, $type_name );
+
+ unless ( $db_members{ $wanted->{node_id} } ) {
+ $member_differences{"$node_name,$type_name" } = [ $xmlnode, $node, $wanted ];
+ }
+ }
+
+ $differences{groupmembers} = \%member_differences if %member_differences;
+
}
- fixNodes(1);
+ return \%differences if %differences;
+ return;
+}
- my $postinst = $script_dir . "/postupdate.pl";
- require $postinst if -f $postinst;
+=head2 C<update_nodeball>
- installModules($dir);
+We already have this nodeball in the system, and we need to figure out which
+files to add, remove, and update.
- print "$$OLDBALL{title} updated.\n";
+=cut
+
+sub update_nodeball {
+ my ( $self, $dir ) = @_;
+
+ my $DB = $self->get_nodebase
+ || Everything::Exception::NoNodeBase->throw("No nodebase here!");
+
+ $dir ||= $self->get_nodeball_dir;
+
+ my $NEWBALLXML = $self->nodeball_xml;
+
+ my $vars = $self->nodeball_vars;
+
+ my $OLDBALL = $self->get_nodebase->getNode( $vars->{title}, 'nodeball');
+
+ #check the tables and make sure that they're compatable
+
+ $self->insert_sql_tables($dir);
+
+ my @nodes = $self->build_new_nodes; # list of new nodes
+
+ foreach my $N (@nodes) {
+ print "$N\n";
+ $self->update_node_to_nodebase( $N );
+ }
+
+ fixNodes(0);
+
+ #insert the new nodeball
+ my $nodelist = xml2node( $NEWBALLXML, 'nofinal' );
+ $OLDBALL->updateFromImport( $$nodelist[0], -1 );
+
+ fixNodes(1);
+
}
=cut
Modified: trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-05-22 23:15:52 UTC (rev 964)
+++ trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-06-06 10:01:02 UTC (rev 965)
@@ -32,7 +32,7 @@
my ($self) = @_;
my $dir = get_temp_dir();
-
+
mkdir $dir;
chdir $dir;
@@ -810,22 +810,6 @@
}
-sub test_check_nodeball_against_nodebase :Test(1) {
- local $TODO = "Unimplemented";
-
- ok( undef, '...runs through each node in the nodeball and checks for type, attributes and values against the node stored in the nodebase.');
-
-
-}
-
-sub test_check_nodebase_against_nodeball :Test(1) {
- local $TODO = "Unimplemented";
-
- ok( undef, '...runs through each node in the nodebase and checks for type, attributes and values against the xmlnode stored in the nodeball.');
-
-
-}
-
sub test_check_nodeball_integrity :Test(4) {
my $self = shift;
@@ -880,44 +864,184 @@
}
-sub test_check_nodeball_presence :Test(4) {
- local $TODO = "Unimplemented.";
+sub test_verify_nodes : Test(1) {
+ my $self = shift;
- my $self = shift;
my $instance = $self->{instance};
- return "unimplemented";
- my $dir = get_temp_dir();
- mkdir $dir;
- my $mock = Test::MockObject->new;
- $instance->set_nodebase( $mock );
- $mock->set_always( selectNodegroupFlat => [ { title => "Duplicate Found", type => { title => 'superdoc' }}, { title => "Create a new user", type => { title => 'htmlcode' }}, { title => "thingo", type => { title => 'thingtype' }} ] );
+ my $mock = $self->{mock};
- $instance->set_nodeball_dir( $dir );
+ $instance->set_nodebase($mock);
- my $mefile = File::Spec->catfile ($dir, 'ME');
- my $fh = IO::File->new( $mefile, 'w' ) || die "Can't open $mefile, $!";
- print $fh <<HERE;
-<NODE export_version="0.5" nodetype="nodeball" title="core system">
- <group>
- <member name="group_node" type="noderef" type_nodetype="theme,nodetype">default theme</member>
- <member name="group_node" type="noderef" type_nodetype="superdoc,nodetype">Create a new user</member>
- <member name="group_node" type="noderef" type_nodetype="superdoc,nodetype">Duplicates Found</member>
-</group>
-</NODE>
-HERE
+ local *Everything::Storage::Nodeball::verify_node;
+ *Everything::Storage::Nodeball::verify_node = sub { 'verified' };
- my ($not_in_nodebase, $not_in_nodeball) = $instance->check_nodeball_integrity;
- my @sorted = sort { $a->get_title cmp $b->get_title } @{ $not_in_nodebase || [] };
- is($sorted[0]->get_title, 'Create a new user', '...not in nodebase when titles same but types are different.');
- is($sorted[1]->get_title, 'default theme', '...not in nodebase when title not presnet.');
+ local *Everything::Storage::Nodeball::nodeball_vars;
+ *Everything::Storage::Nodeball::nodeball_vars =
+ sub { { title => 'nodeballname' } };
- @sorted = sort { $a->{title} cmp $b->{title} } @{ $not_in_nodeball || [] };
- is($sorted[0]->get_title, 'Create a new user', '...not in nodeball when titles same but types are different.');
- is($sorted[1]->get_title, 'default theme', '...not in nodeball when title not presnet.');
+ my @returns = ( $mock, $mock, $mock );
+ local *Everything::Storage::Nodeball::make_node_iterator;
+ *Everything::Storage::Nodeball::make_node_iterator = sub {
+ sub { shift @returns }
+ };
+ $mock->set_always( selectGroupArray => [ 1 .. 4 ] );
+ $mock->set_series(
+ getNode => $mock,
+ $mock, $mock, $mock, $mock, undef, $mock, $mock, $mock, $mock, $mock,
+ $mock, $mock
+ );
+ $mock->set_always( get_nodetype => 'anodetype' );
+ $mock->set_series( get_title => qw/title1 title2 title3 title4/ );
+ $mock->{title} = 'node title';
+ $mock->{type} = $mock;
+ my $rv = $instance->verify_nodes;
+
+ is_deeply(
+ $rv,
+ [
+ [ $mock, undef ],
+ [ $mock, 'verified' ],
+ [ $mock, 'verified' ],
+ [ undef, $mock ]
+ ],
+ '...returns an array ref.'
+ );
}
+sub test_verify_node : Test(4) {
+ my $self = shift;
+ my $instance = $self->{instance};
+ my $xmlnode = Test::MockObject->new;
+ my $node = Test::MockObject->new;
+ my $mock = $self->{mock};
+
+ $instance->set_nodebase( $self->{mock} );
+ $self->{mock}->set_always( getNode => $self->{mock} );
+ $self->{mock}->{title} = 3;
+ $self->{mock}->{node_id} = 123;
+
+ $xmlnode->set_always( 'get_attributes', [ $xmlnode, $xmlnode ] );
+
+ $xmlnode->set_always( get_vars => [] );
+ $xmlnode->set_always( get_group_members => [] );
+
+ $xmlnode->set_always( get_title => 'node name' );
+ $xmlnode->set_always( get_nodetype => 'a nodetype' );
+ $xmlnode->set_series( get_name => 'attribute name', 'att2' );
+ $xmlnode->set_always( get_content => 'attribute content' );
+ $xmlnode->set_always( get_type_nodetype => 'anodetype,nodetype' );
+ $xmlnode->set_series( get_type => 'literal_value', 'noderef' );
+
+ $node->{'attribute name'} = 'attribute content';
+ $node->{'att2'} = 123;
+ my $rv = $instance->verify_node( $xmlnode, $node );
+
+ is( $rv, undef, '...if the same returns nothing.' );
+
+
+
+ $xmlnode->set_series( get_name => 'attribute name', 'att2' );
+ $xmlnode->set_series( get_type => 'literal_value', 'noderef' );
+ $node->{'attribute name'} = 'different content';
+ $node->{'att2'} = 456;
+ $rv = $instance->verify_node( $xmlnode, $node );
+
+ is_deeply(
+ $rv->{attributes},
+ {
+ 'attribute name' =>
+ [
+ $xmlnode,
+ $node,
+ 'literal_value'
+ ],
+ 'att2' =>
+ [
+ $xmlnode,
+ $node,
+ 'noderef',
+ $mock
+ ]
+
+ },
+ '...returns a hash ref explaining differences if doesn\'t match.'
+ );
+
+
+ #Now test vars
+
+ $node->set_always( getVars => { varname1 => 'varvalue', varname2 => 123 } );
+ $xmlnode->set_series( get_name => 'varname1', 'varname2' );
+ $xmlnode->set_always( 'get_attributes' => [] );
+ $xmlnode->set_always( get_vars => [ $xmlnode, $xmlnode] );
+ $xmlnode->set_always( get_group_members => [] );
+ $xmlnode->set_series( get_type => 'literal_value', 'noderef' );
+ $self->{mock}->{title} = "Title of a node retrieved from db.";
+ $self->{mock}->{node_id} = 456;
+ $rv = $instance->verify_node( $xmlnode, $node );
+
+ is_deeply(
+ $rv->{vars},
+ {
+ 'varname1' =>
+ [
+ $xmlnode,
+ $node,
+ 'literal_value'
+ ],
+ 'varname2' =>
+ [
+ $xmlnode,
+ $node,
+ 'noderef',
+ $mock
+ ]
+
+ },
+ '...returns a hash ref explaining var differences if no match.'
+ );
+
+
+ #Now test group members
+
+ $node->set_always( selectGroupArray => [ 1, 2 ] );
+ $xmlnode->set_series( get_name => 'member1', 'member2' );
+ $xmlnode->set_always( 'get_attributes' => [] );
+ $xmlnode->set_always( get_vars => [] );
+ $xmlnode->set_always( get_group_members => [ $xmlnode, $xmlnode ] );
+ $xmlnode->set_series( get_type => 'literal_value', 'noderef' );
+ $self->{mock}->{title} = "Title of a node retrieved from db.";
+ $self->{mock}->{node_id} = 123;
+ $rv = $instance->verify_node( $xmlnode, $node );
+
+ is_deeply(
+ $rv->{groupmembers},
+ {
+ 'member1,anodetype' =>
+ [
+ $xmlnode,
+ $node,
+ $mock
+ ],
+
+ 'member2,anodetype' =>
+ [
+ $xmlnode,
+ $node,
+ $mock
+ ]
+
+ },
+ '...returns a hash ref explaining var differences if no match.'
+ );
+
+
+
+}
+
+
sub parse_sql_file_returns {
(
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-06-06 10:01:28
|
Revision: 966
http://svn.sourceforge.net/everydevel/?rev=966&view=rev
Author: paul_the_nomad
Date: 2007-06-06 03:01:25 -0700 (Wed, 06 Jun 2007)
Log Message:
-----------
Node accessors
Modified Paths:
--------------
trunk/ebase/lib/Everything/Node.pm
trunk/ebase/lib/Everything/NodeBase.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1014
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1015
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Node.pm
===================================================================
--- trunk/ebase/lib/Everything/Node.pm 2007-06-06 10:01:02 UTC (rev 965)
+++ trunk/ebase/lib/Everything/Node.pm 2007-06-06 10:01:25 UTC (rev 966)
@@ -24,6 +24,10 @@
use XML::DOM;
use SUPER;
+use base 'Class::Accessor';
+__PACKAGE__->follow_best_practice;
+__PACKAGE__->mk_accessors(qw/type/);
+
=cut
Modified: trunk/ebase/lib/Everything/NodeBase.pm
===================================================================
--- trunk/ebase/lib/Everything/NodeBase.pm 2007-06-06 10:01:02 UTC (rev 965)
+++ trunk/ebase/lib/Everything/NodeBase.pm 2007-06-06 10:01:25 UTC (rev 966)
@@ -18,6 +18,10 @@
use Everything::NodeCache;
use Everything::NodeBase::Workspace;
+use base 'Class::Accessor';
+__PACKAGE__->follow_best_practice;
+__PACKAGE__->mk_accessors(qw/storage/);
+
use Scalar::Util 'reftype';
BEGIN
@@ -188,10 +192,34 @@
}
}
+ $self->make_node_accessors(\%modules);
$self->load_nodemethods(\%modules);
return \%modules;
}
+sub make_node_accessors {
+ my ( $self, $modules ) = @_;
+ foreach (keys %$modules) {
+ /::(\w+)$/;
+ my $type_name = $1;
+ my $nodetype_node = $self->getNode( $type_name, 'nodetype' );
+
+ my $dbtable;
+ if ($type_name eq 'node' ) {
+ $dbtable = 'node';
+ } else {
+ $dbtable = $nodetype_node->{sqltable};
+ }
+ next unless $dbtable;
+ my @tables = split /,/, $dbtable;
+ my @fields;
+ push @fields, $self->getFields( $_ ) foreach @tables;
+ $_->mk_accessors( @fields );
+ }
+
+
+}
+
sub load_nodemethods {
my ($self, $modules) = @_;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-06-06 10:01:53
|
Revision: 967
http://svn.sourceforge.net/everydevel/?rev=967&view=rev
Author: paul_the_nomad
Date: 2007-06-06 03:01:52 -0700 (Wed, 06 Jun 2007)
Log Message:
-----------
Code to test nodebase nodes against a nodeball
Modified Paths:
--------------
trunk/ebase/lib/Everything/Storage/Nodeball.pm
trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
Added Paths:
-----------
trunk/ebase/bin/verify_nodes.pl
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1015
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1016
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Added: trunk/ebase/bin/verify_nodes.pl
===================================================================
--- trunk/ebase/bin/verify_nodes.pl (rev 0)
+++ trunk/ebase/bin/verify_nodes.pl 2007-06-06 10:01:52 UTC (rev 967)
@@ -0,0 +1,130 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Everything::NodeBase;
+use Everything::Storage::Nodeball;
+use Everything::XML::Node;
+use Text::Reform;
+use Everything::CmdLine qw/get_options usage_options make_nodebase/;
+use Carp;
+
+my $opts = get_options();
+
+usage_options(
+"\nUsage:\n\n\t$0 [options] <nodeball path>\n\nThe <nodeball path> argument is the path to the file of the nodeball we are verifying. \n\n"
+) unless @ARGV >= 1;
+
+my $nb = make_nodebase($opts);
+
+die "No Nodebase" unless $nb;
+
+my $ball =
+ Everything::Storage::Nodeball->new( nodebase => $nb, nodeball => $ARGV[0] );
+
+my ( $in_nodeball, $in_nodebase, $diffs ) = $ball->verify_nodes;
+
+if ( !@$in_nodeball && !@$in_nodebase && !@$diffs ) {
+ print "OK\n";
+ exit;
+}
+
+my $head_form =
+ " |||||||||||||||||||||||||||||||||||||||||||||||||||| ";
+my $head_column =
+"[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[";
+my $column =
+"ball\> [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ base\> [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[";
+
+print form $head_form, "The following nodes are not in the Nodebase"
+ if @$in_nodeball;
+
+foreach (@$in_nodeball) {
+ print form $column,
+ sprintf( "Title: '%s' Type: '%s'\n", $_->get_title, $_->get_nodetype ),
+ "Not in nodebase.";
+}
+print "\n\n";
+
+print form $head_form, "The following nodes are not in the Nodeball"
+ if @$in_nodebase;
+
+foreach (@$in_nodebase) {
+ print form $column, "Not in nodeball",
+ sprintf( "Title: '%s' Type: '%s'\n",
+ $_->get_title, $_->get_type->get_title );
+}
+
+print "\n\n";
+
+
+foreach (@$diffs) {
+
+ my $diff = $$_[1];
+ my $xmlnode = $$_[0];
+
+ print form $head_form, "For Node "
+ . sprintf( "Title: '%s' Type: '%s'\n",
+ $xmlnode->get_title, $xmlnode->get_nodetype );
+
+ foreach ( grep { $_->is_attribute || $_->is_var } @$diff ) {
+
+ my $att_name = $_->get_name || '';
+
+ my $attribute_type = $_->is_attribute ? 'attribute' : 'var';
+
+ if ( !$_->is_noderef ) {
+
+ my $xmlcontent = $_->get_xmlnode_content || '';
+ my @xmllines = split /\n/, $xmlcontent;
+
+ my @baselines = split /\n/, $_->get_nb_node_content || '';
+ print form $head_form, "$attribute_type '$att_name'\n";
+
+ print form $head_column,
+ "In the Nodeball\n$attribute_type '$att_name' is:",
+ "In the Nodebase\n$attribute_type '$att_name' is:";
+ print "\n\n";
+ print form $column, \@xmllines, \@baselines;
+
+ print "\n\n";
+ }
+ else {
+ my $name = $_->get_xmlnode_ref_name || '';
+ my $type = $_->get_xmlnode_ref_type || '';
+
+ my $nb_name = $_->get_nb_node_ref_name || '';
+ my $nb_type = $_->get_nb_node_ref_type || '';
+
+ print form $head_form, "$attribute_type $att_name";
+ print form $column, "references '$name' of type '$type'",
+ "references '$nb_name' of type '$nb_type'\n\n";
+ print "\n\n";
+ }
+ }
+
+ foreach ( grep { $_->is_groupmember } @$diff ) {
+
+ my $in_nodeball = $_->get_xmlnode_additional;
+ my $in_nodebase = $_->get_nb_node_additional;
+
+ foreach (@$in_nodeball) {
+
+ print form $head_form,
+ sprintf( "A node '%s' of type '%s' is:", @$_{ 'title', 'type' } );
+ print form $column, "Is in the nodeball", "Not in the nodebase";
+ }
+
+ foreach (@$in_nodebase) {
+
+ print form $head_form,
+ sprintf( "A node '%s' of type '%s' is:",
+ $_->get_title, $_->get_type->get_title );
+ print form $column, "Not in the nodeball", "Is in the nodebase";
+ }
+
+ print "\n\n";
+ }
+
+}
Property changes on: trunk/ebase/bin/verify_nodes.pl
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Modified: trunk/ebase/lib/Everything/Storage/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-06-06 10:01:25 UTC (rev 966)
+++ trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-06-06 10:01:52 UTC (rev 967)
@@ -790,74 +790,73 @@
=head2 C<verify_nodes>
Cycles through the nodeball and checks each node against what is in the nodebase. the Checks that a node in the nodeball is the same as the one in the nodebase.
-Returns an array ref of array refs.
+Returns a list of array refs.
-Each of the inner array refs are as follows:
+The first is a list of xmlnodes that don't have corresonding entries
+in the nodebase.
-If the node is in the nodeball but not in the nodebase:
+The second is a list of nodes that don't have corresonding xmlnodes
+in the nodeball.
-[ $xmlnode, undef ]
+The third is a list of Everything::Storage::Nodeball::Diff objects
+that set out that differences.
-If the node is in the nodebase (and listed as a member of the nodeball), but not in the nodeball:
+=cut
-[ undef, $node ]
-If the node is in the nodebase and nodeball, but there are differences:
+sub verify_nodes {
+ my ($self) = @_;
-[ $xmlnode, $diff_hash ]
+ my $nb = $self->get_nodebase;
-$diff_hash is a hash of the difference as returned by verify_node().
+ my $iterator = $self->make_node_iterator;
-=cut
+ my $nodebase_nodeball_group =
+ $nb->getNode( $self->nodeball_vars->{title}, 'nodeball' )
+ ->selectGroupArray;
+ ## get nodes in group;
-sub verify_nodes {
- my ( $self ) = @_;
+ my %nodebase_group = map {
+ my $n = $nb->getNode($_);
+ ( "$$n{title},$$n{type}{title}" => 1 );
+ } @$nodebase_nodeball_group;
- my $nb = $self->get_nodebase;
-
- my $iterator = $self->make_node_iterator;
-
my @diffs;
- my $nodebase_nodeball_group = $nb->getNode( $self->nodeball_vars->{title}, 'nodeball')->selectGroupArray;
+ my @in_nodeball;
- ## get nodes in group;
+ my @in_nodebase;
- my %nodebase_group = map { my $n = $nb->getNode( $_ );
- ("$$n{title},$$n{type}{title}" => 1);
- }
- @$nodebase_nodeball_group;
-
XMLNODE:
- while (my $xmlnode = $iterator->() ) {
+ while ( my $xmlnode = $iterator->() ) {
- my $title = $xmlnode->get_title;
- my $type = $xmlnode->get_nodetype;
- my $node = $self->get_nodebase->getNode( $title, $type );
+ my $title = $xmlnode->get_title;
+ my $type = $xmlnode->get_nodetype;
+ my $node = $self->get_nodebase->getNode( $title, $type );
- delete $nodebase_group{ "$title,$type" };
+ delete $nodebase_group{"$title,$type"};
- if ( ! $node) {
+ if ( !$node ) {
- push @diffs, [ $xmlnode, undef ];
- next XMLNODE;
- }
+ push @in_nodeball, $xmlnode;
+ next XMLNODE;
+ }
- if ( my $diff = $self->verify_node( $xmlnode, $node) ) {
+ if ( my $diff = $self->verify_node( $xmlnode, $node ) ) {
- push @diffs, [ $xmlnode, $diff ];
- next XMLNODE;
- }
+ push @diffs, [ $xmlnode, $diff ] ;
+ next XMLNODE;
+ }
}
foreach ( keys %nodebase_group ) {
- my ( $title, $type ) = split /,/, $_;
- push @diffs, [ undef, $nb->getNode( $title, $type ) ];
+ my ( $title, $type ) = split /,/, $_;
+ push @in_nodebase, $nb->getNode( $title, $type );
}
- return \@diffs;
+ return \@in_nodeball, \@in_nodebase, \@diffs;
}
=head2 C<verify_node>
@@ -866,34 +865,11 @@
First argument in the XML::Node object, the second one is the Everything::Node object.
-Returns a hash ref of differences. It has the the following structure.
+Returns an array ref of Everything::Storage::Nodeball::Diff objects.
-{
-
- attribute => { attributename => [ $xmlnode, $node, $attributetype ],
- attributename2 => [ $xmlnode, $node, 'noderef', $referenced_node ],
- ....
- },
-
- var => { varname => [ $xmlnode, $node, 'literal_value' ],
- varname2 => [ $xmlnode, $node, 'noderef', $referenced_node ],
- ....
- },
-
-
- groupmember => { membernodetype,nodetype => [ $xmlnode, $node, $referenced_node ],
- ....
- }
-
-}
-
=cut
-## Arguably, the return value is a little confusing and difficult to
-## unpack, so we should do itwith an Everything::Nodeball::Difference
-## object or something
-
sub verify_node {
my ( $self, $xmlnode, $node ) = @_;
@@ -903,7 +879,7 @@
### nodebae stored in $node
my $nb = $self->get_nodebase;
- my %differences;
+ my @differences;
## verify attributes
my $atts = $xmlnode->get_attributes;
@@ -912,116 +888,56 @@
my $node_title = $xmlnode->get_title;
my $node_type = $xmlnode->get_nodetype;
- my %attribute_differences;
+ foreach (@$atts) {
- foreach (@$atts) {
my $att_name = $_->get_name;
- my $att_type = $_->get_type;
+ my $diff = Everything::Storage::Nodeball::Diff->new( nodebase => $nb );
+ if ( $diff->check_attribute( $xmlnode, $node, $_ ) ) {
- if ( $att_type eq 'literal_value' ) {
+ push @differences, $diff;
+ }
- ## the line below makes undef an empty string to deal
- ## with the way database tables are created at the
- ## moment.
- my $content = defined $_->get_content ? $_->get_content : '';
-
- unless ( $node->{$att_name} eq $content ) {
- $attribute_differences{ $att_name } = [ $xmlnode, $node, $att_type ];
- }
-
- }
- else {
-
- my ($type_name) = split /,/, $_->get_type_nodetype;
- my $node_name = $_->get_content;
-
- my $wanted = $nb->getNode( $node_name, $type_name );
-
- unless ( $node->{$att_name} == $wanted->{node_id} ) {
- $attribute_differences{ $att_name } = [ $xmlnode, $node, $att_type, $wanted ];
- }
-
- }
- $differences{ attributes } = \%attribute_differences if %attribute_differences;
}
### verify vars
- my $vars = $xmlnode->get_vars;
+ my $vars = $xmlnode->get_vars;
if (@$vars) {
my $db_vars = $node->getVars;
- my %var_differences;
-
foreach (@$vars) {
- my $var_name = $_->get_name;
+ my $diff = Everything::Storage::Nodeball::Diff->new( nodebase => $nb );
+ if ( $diff->check_var( $xmlnode, $node, $_ ) ) {
- my $var_type = $_->get_type;
+ push @differences, $diff;
+ }
+ }
+ }
- if ( $var_type eq 'literal_value' ) {
- ## the line below makes undef an empty string to deal
- ## with the way database tables are created at the
- ## moment.
- my $content = defined $_->get_content ? $_->get_content : '';
-
-
- unless ( $db_vars->{$var_name} eq $content ) {
- $var_differences{ $var_name } = [ $xmlnode, $node, $var_type ];
- }
-
- }
- else {
-
- my ($type_name) = split /,/, $_->get_type_nodetype;
- my $node_name = $_->get_content;
-
- my $wanted = $nb->getNode( $node_name, $type_name );
-
- unless ( $db_vars->{$var_name} == $wanted->{node_id} ) {
- $var_differences{ $var_name } = [ $xmlnode, $node, $var_type, $wanted ];
- }
-
-
- }
- }
- $differences{ vars } = \%var_differences if %var_differences;
-
-
- }
## verify group members
my $members = $xmlnode->get_group_members;
if ( @$members ) {
-
- my %db_members = map { $_ => 1 } @{ $node->selectGroupArray };
- my %member_differences;
+ my $diff = Everything::Storage::Nodeball::Diff->new( nodebase => $nb );
+ if ( $diff->check_members( $xmlnode, $node ) ) {
- foreach (@$members) {
-
- my ($type_name) = split /,/, $_->get_type_nodetype;
- my $node_name = $_->get_name;
-
- my $wanted = $nb->getNode( $node_name, $type_name );
-
- unless ( $db_members{ $wanted->{node_id} } ) {
- $member_differences{"$node_name,$type_name" } = [ $xmlnode, $node, $wanted ];
+ push @differences, $diff;
}
- }
- $differences{groupmembers} = \%member_differences if %member_differences;
+
+ }
- }
- return \%differences if %differences;
+ return \@differences if @differences;
return;
}
@@ -1478,4 +1394,181 @@
return 1;
}
+package Everything::Storage::Nodeball::Diff;
+
+{
+
+use Object::InsideOut;
+
+my @nodebase :Field :Arg(nodebase) :Std(nodebase);
+
+my @name :Field :Arg(name) :Std(name); # for attributes and vars
+
+my @is_noderef :Field :Default(0) :Acc(is_noderef);
+
+my @is_var :Field :Default(0) :Acc(is_var);
+
+my @is_attribute :Field :Default(0) :Acc(is_attribute);
+
+my @is_groupmember :Field :Default(0) :Acc(is_groupmember);
+
+my @xmlnode :Field :Arg(xmlnode) :Std(xmlnode);
+
+my @nb_node :Field :arg(nb_node) :Std(nb_node);
+
+my @xmlnode_attribute :Field :Std(xmlnode_attribute) :Type(Everything::XML::Node::Attribute);
+
+my @xmlnode_content :Field :Std(xmlnode_content); #for literal content
+
+my @nb_node_content :Field :Std(nb_node_content); #for literal content
+
+my @xmlnode_ref_name :Field :Std(xmlnode_ref_name); #for noderefs
+
+my @nb_node_ref_name :Field :Std(nb_node_ref_name); #for noderefs
+
+my @xmlnode_ref_type :Field :Std(xmlnode_ref_type); #for noderefs
+
+my @nb_node_ref_type :Field :Std(nb_node_ref_type); #for noderefs
+
+my @xmlnode_additional :Field :Std(xmlnode_additional) :Type(list); # for group members
+
+my @nb_node_additional :Field :Std(nb_node_additional) :Type(list); # for group members
+
+}
+
+sub check_attribute {
+
+ my ( $self, $xmlnode, $nb_node, $xmlnode_attribute ) = @_;
+
+ my $nb = $self->get_nodebase;
+
+ $self->is_attribute(1);
+
+ $self->set_xmlnode($xmlnode);
+ $self->set_nb_node($nb_node);
+
+ my $name = $xmlnode_attribute->get_name;
+
+ $self->set_name($name);
+
+ my $method = 'get_' . $name;
+
+ my $nb_node_content = $nb_node->$method;
+
+ return $self->compare_data( $xmlnode_attribute, $nb_node_content );
+}
+
+sub check_var {
+
+ my ( $self, $xmlnode, $nb_node, $xmlnode_attribute ) = @_;
+
+ my $nb = $self->get_nodebase;
+
+ $self->is_var(1);
+
+ $self->set_xmlnode($xmlnode);
+ $self->set_nb_node($nb_node);
+
+ my $name = $xmlnode_attribute->get_name;
+
+ $self->set_name($name);
+
+ my $vars = $nb_node->getVars;
+
+ my $nb_node_content = $vars->{$name};
+
+ return $self->compare_data( $xmlnode_attribute, $nb_node_content );
+}
+
+sub compare_data {
+
+ my ( $self, $xmlnode_attribute, $nb_node_content ) = @_;
+
+ $nb_node_content ||= '';
+
+ my $nb = $self->get_nodebase;
+
+ my $att_type = $xmlnode_attribute->get_type;
+
+ if ( $att_type eq 'literal_value' ) {
+
+ $self->is_noderef(0);
+
+ my $xmlcontent = $xmlnode_attribute->get_content || '';
+
+ return if $xmlcontent eq $nb_node_content;
+
+ $self->set_xmlnode_content($xmlcontent);
+ $self->set_nb_node_content($nb_node_content);
+
+ }
+ else {
+
+ my ($type_name) = split /,/, $xmlnode_attribute->get_type_nodetype;
+ my $node_name = $xmlnode_attribute->get_content;
+
+ my $expected = $nb->getNode( $node_name, $type_name );
+
+ my $nb_ref = $self->get_nodebase->getNode($nb_node_content);
+
+ return
+ if $expected
+ && $nb_ref
+ && ( $expected->get_node_id == $nb_ref->get_node_id );
+
+ $self->is_noderef(1);
+
+ $self->set_xmlnode_ref_name($node_name);
+ $self->set_xmlnode_ref_type($type_name);
+ $self->set_nb_node_ref_name( $nb_ref->get_title ) if $nb_ref;
+ $self->set_nb_node_ref_type( $nb_ref->get_type->get_title ) if $nb_ref;
+
+ }
+
+ return $self;
+
+}
+
+sub check_members {
+
+ my ( $self, $xmlnode, $nb_node ) = @_;
+
+ my $nb = $self->get_nodebase;
+
+ my @db_members = @{ $nb_node->selectGroupArray }; # node_ids
+ my %db_members = map { $_ => 1 } @db_members;
+
+ my @in_nodeball;
+
+ my $members = $xmlnode->get_group_members;
+
+ MEMBER:
+ foreach (@$members) {
+
+ my ($type_name) = split /,/, $_->get_type_nodetype;
+ my $node_name = $_->get_name;
+
+ my $wanted = $nb->getNode( $node_name, $type_name );
+
+ next MEMBER if $wanted && delete $db_members{ $wanted->get_node_id };
+ push @in_nodeball, { name => $node_name, type => $type_name };
+
+ }
+
+ my @in_nodebase;
+ foreach ( keys %db_members ) {
+
+ my $member = $nb->getNode($_);
+ push @in_nodebase, $member;
+ }
+
+ return if !@in_nodebase && !@in_nodeball;
+
+ $self->is_groupmember(1);
+ $self->set_xmlnode_additional( @in_nodeball ) if @in_nodeball;
+ $self->set_nb_node_additional( @in_nodebase ) if @in_nodebase;
+
+ return $self;
+}
+
1;
Modified: trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-06-06 10:01:25 UTC (rev 966)
+++ trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-06-06 10:01:52 UTC (rev 967)
@@ -864,7 +864,7 @@
}
-sub test_verify_nodes : Test(1) {
+sub test_verify_nodes : Test(3) {
my $self = shift;
my $instance = $self->{instance};
@@ -896,21 +896,20 @@
$mock->{title} = 'node title';
$mock->{type} = $mock;
- my $rv = $instance->verify_nodes;
+ my ( $in_nodeball, $in_nodebase, $diffs ) = $instance->verify_nodes;
+ is_deeply( $in_nodeball, [$mock], '...returns an array ref.' );
+
+ is_deeply( $in_nodebase, [$mock], '...returns an array ref.' );
+
is_deeply(
- $rv,
- [
- [ $mock, undef ],
- [ $mock, 'verified' ],
- [ $mock, 'verified' ],
- [ undef, $mock ]
- ],
+ $diffs,
+ [ [ $mock, 'verified' ], [ $mock, 'verified' ], ],
'...returns an array ref.'
);
}
-sub test_verify_node : Test(4) {
+sub test_verify_node : Test(19) {
my $self = shift;
my $instance = $self->{instance};
my $xmlnode = Test::MockObject->new;
@@ -921,6 +920,7 @@
$self->{mock}->set_always( getNode => $self->{mock} );
$self->{mock}->{title} = 3;
$self->{mock}->{node_id} = 123;
+ $mock->set_always( get_node_id => 123 );
$xmlnode->set_always( 'get_attributes', [ $xmlnode, $xmlnode ] );
@@ -929,51 +929,53 @@
$xmlnode->set_always( get_title => 'node name' );
$xmlnode->set_always( get_nodetype => 'a nodetype' );
- $xmlnode->set_series( get_name => 'attribute name', 'att2' );
+ $xmlnode->set_series( get_name => 'attribute_name', 'attribute_name','attribute_name','attribute_name', 'att2', 'att2', 'att2', 'att2' );
$xmlnode->set_always( get_content => 'attribute content' );
$xmlnode->set_always( get_type_nodetype => 'anodetype,nodetype' );
- $xmlnode->set_series( get_type => 'literal_value', 'noderef' );
+ $xmlnode->set_series( get_type => 'literal_value', 'literal_value', 'noderef', 'noderef' );
- $node->{'attribute name'} = 'attribute content';
+ $node->set_always(get_attribute_name => 'attribute content');
$node->{'att2'} = 123;
+ $node->set_always('get_att2' => 123);
+ $node->mock( selectGroupArray => sub { die } );
+
my $rv = $instance->verify_node( $xmlnode, $node );
is( $rv, undef, '...if the same returns nothing.' );
-
-
- $xmlnode->set_series( get_name => 'attribute name', 'att2' );
+ $xmlnode->set_series( get_name => 'attribute_name', 'attribute_name', 'att2', 'att2', 'att2', 'att2' );
$xmlnode->set_series( get_type => 'literal_value', 'noderef' );
- $node->{'attribute name'} = 'different content';
- $node->{'att2'} = 456;
+ $node->set_always('get_attribute_name' => 'different content');
+ $node->set_always('get_att2' => 456);
+ $mock->set_always( get_title => 'anodetitle' );
+ $mock->set_always( get_type => $mock);
+
+ my @ids = ( 123, 456 );
+ $mock->mock( get_node_id => sub { shift @ids } );
$rv = $instance->verify_node( $xmlnode, $node );
- is_deeply(
- $rv->{attributes},
- {
- 'attribute name' =>
- [
- $xmlnode,
- $node,
- 'literal_value'
- ],
- 'att2' =>
- [
- $xmlnode,
- $node,
- 'noderef',
- $mock
- ]
+ my @diff = sort { $b->get_name cmp $a->get_name } @$rv;
- },
- '...returns a hash ref explaining differences if doesn\'t match.'
- );
+ ok (! $diff[0]->is_noderef, '...is a literal value.');
+ is( $diff[0]->get_nb_node_content, 'different content', '...returns content from nodebase' );
+ is( $diff[0]->get_xmlnode_content, 'attribute content', '...returns content from nodeball.' );
+ ok ( $diff[1]->is_noderef, '...returns a node reference.');
+
+ is( $diff[1]->get_nb_node_ref_name, 'anodetitle', '...returns node name of reference' );
+ is( $diff[1]->get_xmlnode_ref_name, 'attribute content', '...returns nodename of reference in nodeball.' );
+
+ is( $diff[1]->get_nb_node_ref_type, 'anodetitle', '...returns nodetype of reference in nodebase.' );
+ is( $diff[1]->get_xmlnode_ref_type, 'anodetype', '...returns nodetype of reference in nodeball.' );
+
+
#Now test vars
+
+ @ids = ( 123, 456 );
$node->set_always( getVars => { varname1 => 'varvalue', varname2 => 123 } );
- $xmlnode->set_series( get_name => 'varname1', 'varname2' );
+ $xmlnode->set_series( get_name => 'varname1', 'varname1', 'varname2', 'varname2' );
$xmlnode->set_always( 'get_attributes' => [] );
$xmlnode->set_always( get_vars => [ $xmlnode, $xmlnode] );
$xmlnode->set_always( get_group_members => [] );
@@ -982,61 +984,56 @@
$self->{mock}->{node_id} = 456;
$rv = $instance->verify_node( $xmlnode, $node );
- is_deeply(
- $rv->{vars},
- {
- 'varname1' =>
- [
- $xmlnode,
- $node,
- 'literal_value'
- ],
- 'varname2' =>
- [
- $xmlnode,
- $node,
- 'noderef',
- $mock
- ]
+ @diff = sort { $a->get_name cmp $b->get_name } @$rv;
- },
- '...returns a hash ref explaining var differences if no match.'
- );
+ ok (! $diff[0]->is_noderef, '...is var a literal value.');
+ is( $diff[0]->get_nb_node_content, 'varvalue', '...returns var content from nodebase' );
+ is( $diff[0]->get_xmlnode_content, 'attribute content', '...returns var content from nodeball.' );
+ ok ( $diff[1]->is_noderef, '...returns a node reference.');
+
+ is( $diff[1]->get_nb_node_ref_name, 'anodetitle', '...returns node name of reference from var' );
+ is( $diff[1]->get_xmlnode_ref_name, 'attribute content', '...returns nodename of reference in nodeball from var.' );
+
+ is( $diff[1]->get_nb_node_ref_type, 'anodetitle', '...returns nodetype of reference in nodebase from var.' );
+ is( $diff[1]->get_xmlnode_ref_type, 'anodetype', '...returns nodetype of reference in nodeball var.' );
+
#Now test group members
- $node->set_always( selectGroupArray => [ 1, 2 ] );
$xmlnode->set_series( get_name => 'member1', 'member2' );
$xmlnode->set_always( 'get_attributes' => [] );
$xmlnode->set_always( get_vars => [] );
$xmlnode->set_always( get_group_members => [ $xmlnode, $xmlnode ] );
$xmlnode->set_series( get_type => 'literal_value', 'noderef' );
- $self->{mock}->{title} = "Title of a node retrieved from db.";
- $self->{mock}->{node_id} = 123;
+ $node->set_always( selectGroupArray => [ 1, 2 ] );
+ $node->set_always( get_type => $node );
+ $node->set_always( get_node_id => 1);
+ $node->set_always( get_title => 'The node title');
+ $mock->set_always( get_title => "dbnode");
+ $mock->set_always( get_type => $mock );
+ $mock->set_always( get_node_id => 123 );
+
$rv = $instance->verify_node( $xmlnode, $node );
+ my ( $diff ) = @$rv;
is_deeply(
- $rv->{groupmembers},
- {
- 'member1,anodetype' =>
- [
- $xmlnode,
- $node,
- $mock
- ],
-
- 'member2,anodetype' =>
- [
- $xmlnode,
- $node,
- $mock
- ]
-
+ $diff->get_xmlnode_additional,
+ [ {
+ name => 'member1',
+ type => 'anodetype'
},
- '...returns a hash ref explaining var differences if no match.'
+ {
+ name => 'member2',
+ type => 'anodetype'
+ }
+ ]
+ ,
+ '...returns an array ref of hash refs with name & type keys.'
);
+ my $nodes = $diff->get_nb_node_additional;
+ is ( $$nodes[0]->get_title . $$nodes[0]->get_type->get_title, 'dbnodedbnode', '...returns nodes not in nodeball.');
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-06-06 10:02:15
|
Revision: 968
http://svn.sourceforge.net/everydevel/?rev=968&view=rev
Author: paul_the_nomad
Date: 2007-06-06 03:02:13 -0700 (Wed, 06 Jun 2007)
Log Message:
-----------
A couple of utility methods
Modified Paths:
--------------
trunk/ebase/lib/Everything/XML/Node.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1016
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1017
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/XML/Node.pm
===================================================================
--- trunk/ebase/lib/Everything/XML/Node.pm 2007-06-06 10:01:52 UTC (rev 967)
+++ trunk/ebase/lib/Everything/XML/Node.pm 2007-06-06 10:02:13 UTC (rev 968)
@@ -522,6 +522,32 @@
}
+sub get_attribute {
+ my ( $self, $name ) = @_;
+
+ my $atts = $self->get_attributes;
+ foreach ( @$atts ) {
+ next unless $_->get_name eq $name;
+ return $_;
+ }
+
+ return;
+}
+
+
+sub get_var {
+ my ( $self, $name ) = @_;
+
+ my $vars = $self->get_vars;
+ foreach ( @$vars ) {
+ next unless $_->get_name eq $name;
+ return $_;
+ }
+
+ return;
+}
+
+
package Everything::XML::Node::Attribute;
{
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-06-23 09:02:43
|
Revision: 970
http://svn.sourceforge.net/everydevel/?rev=970&view=rev
Author: paul_the_nomad
Date: 2007-06-23 02:02:38 -0700 (Sat, 23 Jun 2007)
Log Message:
-----------
Elimination of global in Auth.pm
Modified Paths:
--------------
trunk/ebase/lib/Everything/Auth.pm
trunk/ebase/lib/Everything/Test/Auth.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1022
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1024
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Auth.pm
===================================================================
--- trunk/ebase/lib/Everything/Auth.pm 2007-06-06 17:40:56 UTC (rev 969)
+++ trunk/ebase/lib/Everything/Auth.pm 2007-06-23 09:02:38 UTC (rev 970)
@@ -19,7 +19,6 @@
package Everything::Auth;
use strict;
-use Everything qw/$DB/;
=cut
@@ -51,6 +50,8 @@
my ( $class, $options ) = @_;
$options ||= {};
+ my $DB = $options->{nodebase};
+
# We may not always get the guest user pref (if ever). We can default to
# plain Guest User
@@ -145,6 +146,8 @@
{
my ( $this, $user ) = @_;
+ my $DB = $this->{options}->{nodebase};
+
$user ||= $DB->getNode( $this->{options}->{guest_user} );
# No user yet? Now would be a good time to cry...
Modified: trunk/ebase/lib/Everything/Test/Auth.pm
===================================================================
--- trunk/ebase/lib/Everything/Test/Auth.pm 2007-06-06 17:40:56 UTC (rev 969)
+++ trunk/ebase/lib/Everything/Test/Auth.pm 2007-06-23 09:02:38 UTC (rev 970)
@@ -9,29 +9,18 @@
use SUPER;
use strict;
-sub startup : Test( startup => +6 ) {
+sub startup : Test( startup => +5 ) {
my $self = shift;
my $db = Test::MockObject->new();
- local *Everything::Auth::DB;
- my @imports;
- *Everything::Auth::DB = \$db;
- $db->fake_module(
- 'Everything',
- import => sub {
- @imports = @_;
- *Everything::Auth::DB = \$db;
- }
- );
-
$self->SUPER;
- is( $imports[1], '$DB', '...should import $DB from Everything.pm' );
+
can_ok( $self->{class}, 'new' );
$db->set_always( getNode => { node_id => 88 } );
$self->{db} = $db;
- my $instance = $self->{class}->new();
+ my $instance = $self->{class}->new( { nodebase => $db } );
isa_ok( $instance, $self->{class} );
$self->{instance} = $instance;
@@ -120,23 +109,22 @@
my $self = shift;
my $package = $self->{class};
my $db = $self->{db};
- local *Everything::Auth::DB;
- *Everything::Auth::DB = \$db;
+ my $instance = $self->{instance};
can_ok( $package, 'generateSession' );
my $mock = Test::MockObject->new();
- $mock->{options} = { guest_user => 'guest' };
+ $instance->{options}->{guest_user} = 'guest';
$mock->set_always( getVars => 'vars' );
$db->set_false('getNode')->clear();
- throws_ok { Everything::Auth::generateSession($mock) }
+ throws_ok { Everything::Auth::generateSession($instance) }
qr/Unable to get user!/, 'generateSession() should die with no user';
my ( $method, $args ) = $db->next_call();
is( $method, 'getNode', '... so should fetch a user given none' );
is( $args->[1], 'guest', '... using guest user option' );
- my @results = Everything::Auth::generateSession( $mock, $mock );
+ my @results = $instance->generateSession( $mock );
is_deeply(
\@results,
[ $mock, 'vars' ],
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-06-23 09:03:27
|
Revision: 971
http://svn.sourceforge.net/everydevel/?rev=971&view=rev
Author: paul_the_nomad
Date: 2007-06-23 02:03:25 -0700 (Sat, 23 Jun 2007)
Log Message:
-----------
Tests for update nodeball. Inclusion of callback for update to allow more
flexible updating such as use of workspacing.
Modified Paths:
--------------
trunk/ebase/lib/Everything/Storage/Nodeball.pm
trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1024
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1025
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Storage/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-06-23 09:02:38 UTC (rev 970)
+++ trunk/ebase/lib/Everything/Storage/Nodeball.pm 2007-06-23 09:03:25 UTC (rev 971)
@@ -671,11 +671,6 @@
$self->write_node_to_nodeball( $nodeball, 'ME' ); # create ME file
my $group = $nodeball->selectNodegroupFlat;
foreach ( @$group ) {
-
- if ( $$_{type}{title} eq 'dbtable' ) {
- $self->write_sql_table_to_nodeball( $$_{title} );
- }
-
$self->write_node_to_nodeball( $_ );
}
@@ -743,17 +738,29 @@
+=head2 C<build_new_nodes>
+
+Iterates through the nodes in the current nodeball and turns them into
+Everything::Node objects that aren't in the NodeBase (i.e. they are
+not stored in the database).
+
+Takes an optional subroutine references which is passed to
+make_node_iterator so that the nodes may be selected.
+
+Returns a list.
+
+=cut
+
sub build_new_nodes {
my ( $self ) = @_;
my $select_cb ||= sub { 1 };
- my $iterator = $self->make_node_iterator();
+ my $iterator = $self->make_node_iterator( $select_cb );
my @nodes;
- while ( my $xmlnode = $iterator->() ) {
+ while ( my $xmlnode = $iterator->( $select_cb ) ) {
my $node = xml2node( $xmlnode->get_raw_xml, 'nofinal' );
- print "@$node\n";
push @nodes, @$node;
}
@@ -761,28 +768,27 @@
}
-sub get_conflicting_nodes {
- my ( $self ) = @_;
-
-
-}
-
sub update_node_to_nodebase {
my ( $self, $node, $handle_conflict_cb ) = @_;
my $oldnode = $node->existingNodeMatches();
## default behaviour is to clobber nodes
- $handle_conflict_cb ||= sub{ $oldnode->updateFromImport( $node, -1 ) };
+ $handle_conflict_cb ||= sub { $oldnode->updateFromImport( $node, -1 ) };
+ if ($oldnode) {
- if ( $oldnode->conflictsWith( $node ) ){
- $handle_conflict_cb->();
- } else {
- $oldnode->updateFromImport( $node, -1 );
+ if ( $oldnode->conflictsWith($node) ) {
+ $handle_conflict_cb->( $self, $node );
+ }
+ else {
+ $oldnode->updateFromImport( $node, -1 );
+ }
+
}
+ else {
+ $node->insert(-1);
+ }
-
-
}
@@ -941,21 +947,31 @@
return;
}
-=head2 C<update_nodeball>
+=head2 C<update_nodebase_from_nodeball>
-We already have this nodeball in the system, and we need to figure out which
-files to add, remove, and update.
+We already have this nodeball in the system, and we are going to
+update it. This does not delete nodes in the existing nodeball and not
+in the new one, it simply removes them from the nodeball in the
+nodebase. Takes an optional second argument of the nodeball directory
+and an optional third argument which is a call back that updates an
+indiviudal node to the nodebase. It is passed the nodeball object and
+a node object as arguments. It defaults to calling
+update_node_to_nodebase.
=cut
-sub update_nodeball {
- my ( $self, $dir ) = @_;
+sub update_nodebase_from_nodeball {
+ my ( $self, $dir, $update_node_cb ) = @_;
my $DB = $self->get_nodebase
|| Everything::Exception::NoNodeBase->throw("No nodebase here!");
$dir ||= $self->get_nodeball_dir;
+ $update_node_cb ||= sub { my ( $nodeball, $node ) = @_;
+ $nodeball->update_node_to_nodebase( $node );
+ };
+
my $NEWBALLXML = $self->nodeball_xml;
my $vars = $self->nodeball_vars;
@@ -969,17 +985,18 @@
my @nodes = $self->build_new_nodes; # list of new nodes
foreach my $N (@nodes) {
- print "$N\n";
- $self->update_node_to_nodebase( $N );
+
+ $update_node_cb->( $self, $N );
}
- fixNodes(0);
+ $self->fix_node_references(0);
#insert the new nodeball
my $nodelist = xml2node( $NEWBALLXML, 'nofinal' );
+
$OLDBALL->updateFromImport( $$nodelist[0], -1 );
- fixNodes(1);
+ $self->fix_node_references(1);
}
@@ -1112,6 +1129,12 @@
my $volume;
my $save_title;
my $save_dir;
+
+
+ if ( $$node{type}{title} eq 'dbtable' ) {
+ $self->write_sql_table_to_nodeball( $$node{title} );
+ }
+
if ( ! $filepath ) {
$save_title = $$node{title};
$save_dir = $$node{type}{title};
Modified: trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-06-23 09:02:38 UTC (rev 970)
+++ trunk/ebase/lib/Everything/Storage/Test/Nodeball.pm 2007-06-23 09:03:25 UTC (rev 971)
@@ -489,23 +489,121 @@
}
-sub test_update_nodebase_from_nodeball : Test(6) {
+sub test_build_new_nodes : Test(2) {
my $self = shift;
+ my $instance = $self->{instance};
- can_ok( $self->{class}, 'update_nodeball' )
- || return 'update_nodeball not implemented.';
+ my $mock = Test::MockObject->new;
+ $mock->set_always( get_raw_xml => 'some xml' );
+
+ my @xmlnodes = ( $mock, $mock );
+ no strict 'refs';
+ local *{ $self->{class} . '::make_node_iterator' };
+ *{ $self->{class} . '::make_node_iterator' } = sub { sub { shift @xmlnodes } };
+ my @xml2node_args = ();
+ local *{ $self->{class} . '::xml2node' };
+ *{ $self->{class} . '::xml2node' } = sub { push @xml2node_args, $_[0], $_[1]; return [ $mock ] };
+ use strict 'refs';
+
+ my @nodes = $instance->build_new_nodes;
+
+ is_deeply ( \@nodes, [ $mock, $mock ], '...returns a list of node objects.');
+ is_deeply ( \@xml2node_args, ['some xml', 'nofinal', 'some xml', 'nofinal' ], '...calls xml2node with nofinal argument.');
+}
+
+sub test_update_node_to_nodebase :Test(9) {
+ my $self = shift;
my $instance = $self->{instance};
+ my $node = Test::MockObject->new;
+ my $oldnode = Test::MockObject->new;
- local $TODO = "Analyse, break down and fix update nodeball.";
+ $oldnode->set_true('updateFromImport');
+ $oldnode->set_series(conflictsWith => 1, 0);
- my $mock = Test::MockObject->new;
- ok( undef, '...reads XML nodeball.' );
- ok( undef,
- '...finds nodes in old nodeball that have been modified since install.'
+ $node->set_series( existingNodeMatches => $oldnode, undef );
+ $node->set_true('insert');
+
+ $instance->update_node_to_nodebase( $node );
+
+ my ( $method, $args ) = $node->next_call;
+
+ is( $method, 'existingNodeMatches', '....checks to see whether a node is matching.');
+
+ ( $method, $args ) = $oldnode->next_call;
+ is($method, 'conflictsWith', '...tries to see whether an importing node is conflicting.');
+ is($args->[1], $node, '...with the new node as an argument.');
+
+ ( $method, $args ) = $oldnode->next_call;
+ is($method, 'updateFromImport', '...calls the nodes updateFromImport method.');
+ is($args->[1], $node, '...with the new node as an argument.');
+ is($args->[2], -1, '...and the superuser.');
+
+ $instance->update_node_to_nodebase( $node );
+
+ ( $method, $args ) = $node->next_call;
+
+ is( $method, 'existingNodeMatches', '....checks to see whether a node is matching.');
+
+ ( $method, $args ) = $oldnode->next_call;
+
+ ( $method, $args ) = $node->next_call;
+ is($method, 'insert', '...calls the nodes insert method.');
+ is($args->[1], -1, '...and the superuser.');
+
+}
+
+sub test_update_nodebase_from_nodeball : Test(11) {
+ my $self = shift;
+
+ can_ok( $self->{class}, 'update_nodebase_from_nodeball' )
+ || return 'update_nodeball not implemented.';
+
+ my $instance =
+ Test::MockObject::Extends::InsideOut->new( $self->{instance} );
+
+ $instance->set_always( nodeball_xml => 'some xml' );
+ $instance->set_always( -nodeball_vars => { title => 'foobar' } );
+ $instance->set_true( 'insert_sql_tables', 'update_node_to_nodebase',
+ 'fix_node_references' );
+
+ my $mock = $self->{mock};
+ $mock->set_always( getNode => $mock );
+ $mock->set_true('updateFromImport');
+ $instance->set_nodebase($mock);
+ $instance->set_list( 'build_new_nodes' => $mock, $mock );
+
+ $instance->update_nodebase_from_nodeball;
+
+ my ( $method, $args ) = $instance->next_call;
+ is( $method, 'nodeball_xml', '...reads XML nodeball.' );
+
+ ( $method, $args ) = $instance->next_call;
+ is( $method, 'insert_sql_tables', '...tries to insert all sql tables.' );
+ ( $method, $args ) = $instance->next_call;
+ is( $method, 'build_new_nodes',
+ '...turns all new nodes into node objects.' );
+ ( $method, $args ) = $instance->next_call;
+ is( $method, 'update_node_to_nodebase',
+'...inserts/updates the node into the nodebase according to the algorithm.'
);
- ok( undef, '...workspaces updated new nodes if possibole.' );
- ok( undef, '...if not then asks for instructions.' );
- ok( undef, '...updates nodeball data.' );
+ is( $$args[1], $mock, '...calls with the newly created node object.' );
+
+ ( $method, $args ) = $instance->next_call;
+ is( $method, 'update_node_to_nodebase',
+'...inserts/updates the node into the nodebase according to the algorithm.'
+ );
+ is( $$args[1], $mock, '...calls with the newly created node object.' );
+
+ ( $method, $args ) = $instance->next_call;
+ is( $method, 'fix_node_references', '...fixes references.' );
+
+ ( $method, $args ) = $mock->next_call(2);
+ is( $method, 'updateFromImport',
+ '...calls updateFromImport against the old nodeball.' );
+
+ ( $method, $args ) = $instance->next_call;
+ is( $method, 'fix_node_references', '...and finally fixes references.' );
+
}
sub test_check_named_tables : Test(3) {
@@ -592,29 +690,39 @@
}
-sub test_export_nodeball : Test(7) {
+sub test_export_nodeball_to_directory : Test(4) {
my $self = shift;
- local $TODO = "Methods to export a nodeball stored in a nodebase.";
- can_ok( $self->{class}, 'export_nodeball' );
+ my $instance= Test::MockObject::Extends::InsideOut->new( $self->{instance} );
+ my $mock = $self->{mock};
+ $mock->set_always( getNode => $mock );
+ $mock->set_always( 'selectNodegroupFlat' => [$mock, $mock, $mock] );
+ $instance->set_nodebase( $mock );
+ $instance->set_true('write_node_to_nodeball');
+ can_ok( $self->{class}, 'export_nodeball_to_directory' );
+
+
my @toXMLReturns = ('me file contents', 'data');
- local *Everything::XML::Node;
+ local *Everything::XML::Node::toXML;
*Everything::XML::Node::toXML = sub { shift @toXMLReturns };
### calls update_nodeball_from_nodebase;
- ok( undef, '.... read nodeball data.' );
+ $instance->export_nodeball_to_directory('nodeballname', 'tmpdir');
+ my ($method, $args) = $mock->next_call;
+ is( "$method..$$args[1]$$args[2]", 'getNode..nodeballnamenodeball', '.... read nodeball data.' );
- ok( undef, '....create ME file and put nodeball data into it.' );
+ ($method, $args) = $instance->next_call;
+ is( "$method$$args[1]$$args[2]", "write_node_to_nodeball${mock}ME", '....create ME file and put nodeball data into it.' );
- ok( undef, '...create table sql files.' );
+ my $nodedata;
+ for (1..3) {
+ ($method, $args) = $instance->next_call;
+ $nodedata .= "$method$$args[1]";
+ }
+ is( $nodedata, "write_node_to_nodeball$mock" x 3, '...export each node in the nodeball group as xml.' );
- ok( undef, '...export each node in the nodeball group as xml.' );
-
- ok( undef, '...compress nodeball and name it .nbz file.' );
-
- ok( undef, '...clean up working directory.' );
}
sub test_remove_nodeball : Test( 5 ) {
@@ -852,14 +960,14 @@
use strict 'refs';
my ($not_in_ME, $not_in_nodeball) = $instance->check_nodeball_integrity;
- use Data::Dumper; diag Dumper $not_in_ME, $not_in_nodeball;
+
my @sorted = sort { $a->{title} cmp $b->{title} } @$not_in_ME;
is($sorted[0]->{title}, 'Create a new user', '...not in ME when titles same but types are different.');
is($sorted[1]->{title}, 'thingo', '...not in ME when title not presnet.');
@sorted = sort { $a->{title} cmp $b->{title} } @$not_in_nodeball;
is($sorted[0]->{title}, 'Create a new user', '...not in nodeball when titles same but types are different.');
- is($sorted[1]->{title}, 'Duplicates Found', '...not in nodeball when title not presnet.');
+ is($sorted[1]->{title}, 'Duplicates Found', '...not in nodeball when title not present.');
}
@@ -1070,4 +1178,43 @@
);
}
+
+
+package Test::MockObject::Extends::InsideOut;
+
+use SUPER;
+use base 'Test::MockObject::Extends';
+
+our $AUTOLOAD;
+
+sub new {
+ my ( $class, $fake_class ) = @_;
+
+ return Test::MockObject->new() unless defined $fake_class;
+
+ my $parent_class = $class->get_class($fake_class);
+ $class->check_class_loaded($parent_class);
+ my $self = { _oio => $fake_class };
+
+ bless $self, $class->gen_package($parent_class);
+}
+
+sub gen_package {
+ my ( $class, $parent ) = @_;
+ my $package = $class->SUPER($parent);
+
+ eval qq|package $package;
+use overload
+ '\${}' => sub { return shift()->{_oio} },
+|;
+
+ die "Can't overload scalar dereferencing, $@" if $@;
+ no strict 'refs';
+
+ *{ $package . '::DESTROY' } =
+ sub { shift()->{_oio}->DESTROY };
+
+ return $package;
+}
+
1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-07-24 18:04:33
|
Revision: 974
http://svn.sourceforge.net/everydevel/?rev=974&view=rev
Author: paul_the_nomad
Date: 2007-07-24 11:04:26 -0700 (Tue, 24 Jul 2007)
Log Message:
-----------
Fix for DBD::sqlite's new 'schema has changed' feature
Modified Paths:
--------------
trunk/ebase/lib/Everything/DB/sqlite.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1030
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1030
1b7afbaf-3eae-422c-ad05-e2bef7c06a0f:/wip/ebase:978
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/DB/sqlite.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/sqlite.pm 2007-07-01 20:45:28 UTC (rev 973)
+++ trunk/ebase/lib/Everything/DB/sqlite.pm 2007-07-24 18:04:26 UTC (rev 974)
@@ -83,7 +83,7 @@
unless ( exists $DBTABLE->{Fields} )
{
- my $sth = $this->{dbh}->prepare_cached( "PRAGMA table_info($table)" );
+ my $sth = $this->{dbh}->prepare( "PRAGMA table_info($table)" );
$sth->execute();
while ( my $table_desc = $sth->fetchrow_arrayref()) {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2007-07-24 18:05:20
|
Revision: 975
http://svn.sourceforge.net/everydevel/?rev=975&view=rev
Author: paul_the_nomad
Date: 2007-07-24 11:05:18 -0700 (Tue, 24 Jul 2007)
Log Message:
-----------
Fix in test for 'schema' changed feature of DBD::sqlite
Modified Paths:
--------------
trunk/ebase/lib/Everything/DB/Test/sqlite.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1030
1b7afbaf-3eae-422c-ad05-e2bef7c06a0f:/wip/ebase:978
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:1030
1b7afbaf-3eae-422c-ad05-e2bef7c06a0f:/wip/ebase:979
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/DB/Test/sqlite.pm
===================================================================
--- trunk/ebase/lib/Everything/DB/Test/sqlite.pm 2007-07-24 18:04:26 UTC (rev 974)
+++ trunk/ebase/lib/Everything/DB/Test/sqlite.pm 2007-07-24 18:05:18 UTC (rev 975)
@@ -73,7 +73,7 @@
my @fields1 = qw/foo bar/;
my @fields2 = qw/ saturn jupiter /;
- $self->{instance}->{dbh}->mock( 'prepare_cached', sub { shift; } );
+ $self->{instance}->{dbh}->mock( 'prepare', sub { shift; } );
$self->{instance}->{dbh}
->set_series( 'fetchrow_arrayref', \@fields1, \@fields2 );
my $DBTABLE = {};
@@ -87,7 +87,7 @@
'table-dbtable', '... by name, of dbtable type' );
( $method, $args ) = $self->{instance}->{dbh}->next_call();
- is( $method, 'prepare_cached', '... displaying the table columns' );
+ is( $method, 'prepare', '... displaying the table columns' );
is(
$args->[1],
'PRAGMA table_info(table)',
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