Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add a command to create a new node. Do not always rebuild the database.

  • Loading branch information...
commit 5a6d9e4c69b0be17ed3536502a6843d1fd1a5813 1 parent 0672e9e
Rocco Caputo authored
Showing with 41 additions and 12 deletions.
  1. +41 −12 trunk/test.perl
53 trunk/test.perl
View
@@ -4,15 +4,17 @@
use warnings;
use strict;
+use constant REBUILD => 0;
+
use ThirdLobe::ArcStore;
### Connect to the arc database.
-my $kts = ThirdLobe::ArcStore->connect("dbi:Pg:dbname=know", "", "");
+my $kts = ThirdLobe::ArcStore->connect("dbi:Pg:host=127.0.0.1;port=15432;dbname=know", "", "");
### Destroy the database, and rebuild it from scratch.
-$kts->rebuild();
+REBUILD and $kts->rebuild();
### Define some arcs.
@@ -27,19 +29,21 @@
[ "name", "is a member of", "Richard Soderberg" ],
);
-foreach (@arcs) {
- my ($subject, $predicate, $object) = @$_;
- $kts->arc_store($subject, $predicate, $object)
- or die "couldn't store arc ($subject) ($predicate) ($object)";
-}
+if (REBUILD) {
+ foreach (@arcs) {
+ my ($subject, $predicate, $object) = @$_;
+ $kts->arc_store($subject, $predicate, $object)
+ or die "couldn't store arc ($subject) ($predicate) ($object)";
+ }
-### Define some meta-arcs.
+ ### Define some meta-arcs.
-my $email = $kts->arc_fetch("email", "is a member of", "Richard Soderberg");
-$kts->arc_store($email, "has the value", "ideas\@crystalflame.net");
+ my $email = $kts->arc_fetch("email", "is a member of", "Richard Soderberg");
+ $kts->arc_store($email, "has the value", "ideas\@crystalflame.net");
-my $name = $kts->arc_fetch("name", "is a member of", "Richard Soderberg");
-$kts->arc_store($name, "has the value", "Richard Soderberg");
+ my $name = $kts->arc_fetch("name", "is a member of", "Richard Soderberg");
+ $kts->arc_store($name, "has the value", "Richard Soderberg");
+}
### Start a little shell to investigate what's done.
@@ -50,6 +54,30 @@
while (defined(my $input = $term->readline($prompt))) {
print "\n";
+ # new node
+
+ if (
+ $input =~
+ /^\s*new\s*\(\s*(.+?)\s*\)\s+\(\s*(.+?)\s*\)\s+\(\s*(.+?)\s*\)\s*$/
+ ) {
+ my ($subject, $predicate, $object) = ($1, $2, $3);
+ $subject =~ s/\s+/ /g;
+ $predicate =~ s/\s+/ /g;
+ $object =~ s/\s+/ /g;
+
+ my $arc = $kts->arc_store($subject, $predicate, $object);
+
+ print(
+ "\tarc ", $arc->seq(),
+ " = (", $arc->sub_seq(),
+ ",", $arc->prd_seq(),
+ ",", $arc->obj_seq(),
+ ") = ", $kts->arc_text($arc), "\n"
+ );
+
+ next;
+ }
+
# fetch node
if ($input =~ /^node\s+(\S.*?)\s*$/) {
my $anchor = $kts->anchor_fetch($1);
@@ -94,6 +122,7 @@
"\t\tarc () (is a type of) (predicate)\n",
"\t\tarc () () ()\n",
"\t^C or Ctrl+C to quit.\n",
+ "\tnew (<text>) (<text>) (<text>) - creates and saves a new arc\n",
);
next;
}
Please sign in to comment.
Something went wrong with that request. Please try again.