Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Fix tabs vs. spaces. Tell Subversion to expand Id tags.

  • Loading branch information...
commit 6065ac5674853495b26b36fe798f23d8fe630ca9 1 parent 1262d94
@rcaputo authored
Showing with 254 additions and 252 deletions.
  1. +2 −0  trunk/NOTES
  2. +252 −252 trunk/ThirdLobe/Database.pm
View
2  trunk/NOTES
@@ -1,3 +1,5 @@
+$Id$
+
Concepts
An "arc mask" is an arc specification used to query for arcs. They
View
504 trunk/ThirdLobe/Database.pm
@@ -38,26 +38,26 @@ some TEXT. Returns a ThirdLobe::Node object on success.
TODO - Currently does not have a failure mode.
- my $node_object = $db->node_add($arc_object, "some text");
+ my $node_object = $db->node_add($arc_object, "some text");
=cut
sub node_add {
- my ($self, $arc, $text) = @_;
- my $dbh = $self->[DBH];
+ my ($self, $arc, $text) = @_;
+ my $dbh = $self->[DBH];
- # Hash the node's text for its key.
- my $key = $self->_node_hash($text);
+ # Hash the node's text for its key.
+ my $key = $self->_node_hash($text);
- # Insert the node.
- my $sth = $dbh->prepare_cached(
- "INSERT INTO node (arc_seq, val_key, val_text) VALUES (?, ?, ?)"
- );
- $sth->execute($arc->seq(), $key, $text) or die $sth->errstr();
- $sth->finish();
+ # Insert the node.
+ my $sth = $dbh->prepare_cached(
+ "INSERT INTO node (arc_seq, val_key, val_text) VALUES (?, ?, ?)"
+ );
+ $sth->execute($arc->seq(), $key, $text) or die $sth->errstr();
+ $sth->finish();
- # Fetch the node back out, with a sequence number and all.
- return $self->node_from_text($text);
+ # Fetch the node back out, with a sequence number and all.
+ return $self->node_from_text($text);
}
=head2 _node_hash TEXT
@@ -69,7 +69,7 @@ The current return value is TEXT that is folded to lowercase, and
whitespace normalized. More complex algorithms may emerge as usage
dictates.
- my $key = $db->_node_hash("some text");
+ my $key = $db->_node_hash("some text");
B<Changing the algorithm will invalidate all your nodes. Don't do
this lightly.>
@@ -77,15 +77,15 @@ this lightly.>
=cut
sub _node_hash {
- my ($self, $text) = @_;
+ my ($self, $text) = @_;
- # Simple hashing. We can do better later.
- my $key = lc($text);
- $key =~ s/\s+/ /g;
- $key =~ s/^\s+//;
- $key =~ s/\s+$//;
+ # Simple hashing. We can do better later.
+ my $key = lc($text);
+ $key =~ s/\s+/ /g;
+ $key =~ s/^\s+//;
+ $key =~ s/\s+$//;
- return $key;
+ return $key;
}
=head2 node_from_text TEXT
@@ -94,25 +94,25 @@ Look up a node record in the database for a given piece of TEXT.
Returns a ThirdLobe::Node object representing the TEXT, or undef on
failure.
- my $node_object = $db->node_from_text("some text");
+ my $node_object = $db->node_from_text("some text");
=cut
sub node_from_text {
- my ($self, $text) = @_;
- my $dbh = $self->[DBH];
+ my ($self, $text) = @_;
+ my $dbh = $self->[DBH];
- # Hash the node's text for its key.
- my $key = $self->_node_hash($text);
+ # Hash the node's text for its key.
+ my $key = $self->_node_hash($text);
- my $sth = $dbh->prepare_cached("SELECT * FROM node WHERE val_key = ?");
- $sth->execute($key);
+ my $sth = $dbh->prepare_cached("SELECT * FROM node WHERE val_key = ?");
+ $sth->execute($key);
- my $row = $sth->fetchrow_hashref();
- $sth->finish();
+ my $row = $sth->fetchrow_hashref();
+ $sth->finish();
- return unless $row;
- return ThirdLobe::Node->new($row);
+ return unless $row;
+ return ThirdLobe::Node->new($row);
}
=head2 node_from_seq NODE_SEQ
@@ -123,22 +123,22 @@ creation. This is the node table's primary key.
node_from_seq() fetches a node record by this ID and returns a
ThirdLobe::Node object representing it. Returns undef on failure.
- my $node_object = $db->node_from_seq(42);
+ my $node_object = $db->node_from_seq(42);
=cut
sub node_from_seq {
- my ($self, $node_seq) = @_;
- my $dbh = $self->[DBH];
+ my ($self, $node_seq) = @_;
+ my $dbh = $self->[DBH];
- my $sth = $dbh->prepare_cached("SELECT * FROM node WHERE seq = ?");
- $sth->execute($node_seq);
+ my $sth = $dbh->prepare_cached("SELECT * FROM node WHERE seq = ?");
+ $sth->execute($node_seq);
- my $row = $sth->fetchrow_hashref();
- $sth->finish();
+ my $row = $sth->fetchrow_hashref();
+ $sth->finish();
- return unless $row;
- return ThirdLobe::Node->new($row);
+ return unless $row;
+ return ThirdLobe::Node->new($row);
}
=head2 node_from_anchor ANCHOR
@@ -147,22 +147,22 @@ Retrieves the node record associated with an anchor arc, and returns a
ThirdLobe::Node representing the record. Returns undef if there's no
node for the anchor.
- my $node_object = $db->node_from_anchor($arc_object);
+ my $node_object = $db->node_from_anchor($arc_object);
=cut
sub node_from_anchor {
- my ($self, $anchor) = @_;
- my $dbh = $self->[DBH];
+ my ($self, $anchor) = @_;
+ my $dbh = $self->[DBH];
- my $sth = $dbh->prepare_cached("SELECT * FROM node WHERE arc_seq = ?");
- $sth->execute($anchor->seq());
+ my $sth = $dbh->prepare_cached("SELECT * FROM node WHERE arc_seq = ?");
+ $sth->execute($anchor->seq());
- my $row = $sth->fetchrow_hashref();
- $sth->finish();
+ my $row = $sth->fetchrow_hashref();
+ $sth->finish();
- return unless $row;
- return ThirdLobe::Node->new($row);
+ return unless $row;
+ return ThirdLobe::Node->new($row);
}
=head1 ARC METHODS
@@ -173,40 +173,40 @@ Builds the SQL WHERE clause and corresponding list of values for
fetching arcs that match up to three arc objects. Undefined arc
objects act as wildcards.
- my ($where, @values) = $db->build_arc_query(
- $subject_arc, $predicate_arc, $object_arc
- );
+ my ($where, @values) = $db->build_arc_query(
+ $subject_arc, $predicate_arc, $object_arc
+ );
=cut
sub build_arc_query {
- my ($self, $sub_anchor, $prd_anchor, $obj_anchor) = @_;
-
- my (@wheres, @values);
- if (defined $sub_anchor) {
- push @wheres, "sub_seq = ?";
- push @values, $sub_anchor->seq();
- }
-
- if (defined $prd_anchor) {
- push @wheres, "prd_seq = ?";
- push @values, $prd_anchor->seq();
- }
-
- if (defined $obj_anchor) {
- push @wheres, "obj_seq = ?";
- push @values, $obj_anchor->seq();
- }
-
- my $where_clause;
- if (@wheres) {
- $where_clause = " WHERE " . join(" AND ", @wheres);
- }
- else {
- $where_clause = "";
- }
-
- return $where_clause, @values;
+ my ($self, $sub_anchor, $prd_anchor, $obj_anchor) = @_;
+
+ my (@wheres, @values);
+ if (defined $sub_anchor) {
+ push @wheres, "sub_seq = ?";
+ push @values, $sub_anchor->seq();
+ }
+
+ if (defined $prd_anchor) {
+ push @wheres, "prd_seq = ?";
+ push @values, $prd_anchor->seq();
+ }
+
+ if (defined $obj_anchor) {
+ push @wheres, "obj_seq = ?";
+ push @values, $obj_anchor->seq();
+ }
+
+ my $where_clause;
+ if (@wheres) {
+ $where_clause = " WHERE " . join(" AND ", @wheres);
+ }
+ else {
+ $where_clause = "";
+ }
+
+ return $where_clause, @values;
}
=head2 arc_add SUBJECT_ARC, PREDICATE_ARC, OBJECT_ARC
@@ -214,24 +214,24 @@ sub build_arc_query {
Add an arc that associates three other arcs. Returns a new
ThirdLobe::Arc object, or undef on failure.
- my $arc = $db->arc_add($subject_arc, $predicate_arc, $object_arc);
+ my $arc = $db->arc_add($subject_arc, $predicate_arc, $object_arc);
=cut
sub arc_add {
- my ($self, $sub_arc, $prd_arc, $obj_arc) = @_;
- my $dbh = $self->[DBH];
-
- # Insert the arc.
- my $sth = $dbh->prepare_cached(
- "INSERT INTO arc (sub_seq, prd_seq, obj_seq) VALUES (?, ?, ?)"
- );
- $sth->execute($sub_arc->seq(), $prd_arc->seq(), $obj_arc->seq())
- or die $sth->errstr();
- $sth->finish();
-
- # Fetch the arc back out, with sequence number and all.
- return $self->arc_from_arcs($sub_arc, $prd_arc, $obj_arc);
+ my ($self, $sub_arc, $prd_arc, $obj_arc) = @_;
+ my $dbh = $self->[DBH];
+
+ # Insert the arc.
+ my $sth = $dbh->prepare_cached(
+ "INSERT INTO arc (sub_seq, prd_seq, obj_seq) VALUES (?, ?, ?)"
+ );
+ $sth->execute($sub_arc->seq(), $prd_arc->seq(), $obj_arc->seq())
+ or die $sth->errstr();
+ $sth->finish();
+
+ # Fetch the arc back out, with sequence number and all.
+ return $self->arc_from_arcs($sub_arc, $prd_arc, $obj_arc);
}
=head2 arc_from_arcs SUBJECT_ARC, PREDICATE_ARC, OBJECT_ARC
@@ -240,34 +240,34 @@ Fetch zero or more arcs that match a given SUBJECT_ARC, PREDICATE_ARC,
and OBJECT_ARC. The three arcs are usually but not always anchors.
Undefined parameters are treated as wildcards.
- my $new_arc = $db->arc_from_arcs(
- $subject_arc, $predicate_arc, $object_arc
- );
+ my $new_arc = $db->arc_from_arcs(
+ $subject_arc, $predicate_arc, $object_arc
+ );
=cut
sub arc_from_arcs {
- my ($self, $sub_arc, $prd_arc, $obj_arc) = @_;
- my $dbh = $self->[DBH];
+ my ($self, $sub_arc, $prd_arc, $obj_arc) = @_;
+ my $dbh = $self->[DBH];
- my ($where_clause, @values) = $self->build_arc_query(
- $sub_arc, $prd_arc, $obj_arc
- );
+ my ($where_clause, @values) = $self->build_arc_query(
+ $sub_arc, $prd_arc, $obj_arc
+ );
- my $sth = $dbh->prepare_cached("SELECT * FROM arc" . $where_clause);
- $sth->execute(@values);
+ my $sth = $dbh->prepare_cached("SELECT * FROM arc" . $where_clause);
+ $sth->execute(@values);
- my (%memo, @arcs);
- while (my $row = $sth->fetchrow_hashref()) {
+ my (%memo, @arcs);
+ while (my $row = $sth->fetchrow_hashref()) {
- # The (0,0,0,0) arc doesn't officially exist.
- next unless $row->{seq};
+ # The (0,0,0,0) arc doesn't officially exist.
+ next unless $row->{seq};
- push @arcs, ThirdLobe::Arc->new($row);
- }
- $sth->finish();
+ push @arcs, ThirdLobe::Arc->new($row);
+ }
+ $sth->finish();
- return @arcs;
+ return @arcs;
}
=head2 arc_count SUBJECT_ARC, PREDICATE_ARC, OBJECT_ARC
@@ -276,30 +276,30 @@ Counts the number of arcs that match up to three other arcs.
Undefined parameters are treated as wildcards. Returns the number of
arcs that were found.
- my $number_found = $db->arc_count(
- $subject_arc, $predicate_arc, $object_arc
- );
+ my $number_found = $db->arc_count(
+ $subject_arc, $predicate_arc, $object_arc
+ );
=cut
sub arc_count {
- my ($self, $sub_arc, $prd_arc, $obj_arc) = @_;
- my $dbh = $self->[DBH];
+ my ($self, $sub_arc, $prd_arc, $obj_arc) = @_;
+ my $dbh = $self->[DBH];
- my ($where_clause, @values) = $self->build_arc_query(
- $sub_arc, $prd_arc, $obj_arc
- );
+ my ($where_clause, @values) = $self->build_arc_query(
+ $sub_arc, $prd_arc, $obj_arc
+ );
- my $sth = $dbh->prepare_cached(
- "SELECT count(seq) FROM arc" . $where_clause
- );
- $sth->execute(@values);
+ my $sth = $dbh->prepare_cached(
+ "SELECT count(seq) FROM arc" . $where_clause
+ );
+ $sth->execute(@values);
- my @row = $sth->fetchrow_array();
- $sth->finish();
+ my @row = $sth->fetchrow_array();
+ $sth->finish();
- return unless @row;
- return $row[0];
+ return unless @row;
+ return $row[0];
}
=head2 anchor_add
@@ -307,31 +307,31 @@ sub arc_count {
Create a new anchor arc record, and return a ThirdLobe::Arc object to
represent it.
- my $arc_object = $db->anchor_add();
+ my $arc_object = $db->anchor_add();
=cut
sub anchor_add {
- my $self = shift;
- my $dbh = $self->[DBH];
-
- # Insert the arc.
- my $sth = $dbh->prepare_cached(
- "INSERT INTO arc (sub_seq, prd_seq, obj_seq) VALUES (0, 0, 0)"
- );
- $sth->execute() or die $sth->errstr();
- $sth->finish();
-
- # Return an arc representing it.
- return ThirdLobe::Arc->new(
- {
- db => $self,
- seq => $dbh->last_insert_id(undef, undef, "arc", undef),
- sub_seq => 0,
- prd_seq => 0,
- obj_seq => 0,
- }
- );
+ my $self = shift;
+ my $dbh = $self->[DBH];
+
+ # Insert the arc.
+ my $sth = $dbh->prepare_cached(
+ "INSERT INTO arc (sub_seq, prd_seq, obj_seq) VALUES (0, 0, 0)"
+ );
+ $sth->execute() or die $sth->errstr();
+ $sth->finish();
+
+ # Return an arc representing it.
+ return ThirdLobe::Arc->new(
+ {
+ db => $self,
+ seq => $dbh->last_insert_id(undef, undef, "arc", undef),
+ sub_seq => 0,
+ prd_seq => 0,
+ obj_seq => 0,
+ }
+ );
}
=head2 arc_from_seq ARC_SEQ
@@ -342,24 +342,24 @@ used as the arc table's primary key.
arc_from_seq() returns a ThirdLobe::Arc object representing the arc
record with a given ARC_SEQ.
- my $arc_object = $db->arc_from_seq(42);
+ my $arc_object = $db->arc_from_seq(42);
=cut
sub arc_from_seq {
- my ($self, $seq) = @_;
- my $dbh = $self->[DBH];
+ my ($self, $seq) = @_;
+ my $dbh = $self->[DBH];
- my $sth = $dbh->prepare_cached("SELECT * FROM arc WHERE seq = ?");
- $sth->execute($seq);
+ my $sth = $dbh->prepare_cached("SELECT * FROM arc WHERE seq = ?");
+ $sth->execute($seq);
- # TODO - Error checking. Return undef on failure.
+ # TODO - Error checking. Return undef on failure.
- my $row = $sth->fetchrow_hashref();
- my $arc = ThirdLobe::Arc->new($row);
+ my $row = $sth->fetchrow_hashref();
+ my $arc = ThirdLobe::Arc->new($row);
- $sth->finish();
- return $arc;
+ $sth->finish();
+ return $arc;
}
=head1 WHOLE DATABASE METHODS
@@ -370,91 +370,91 @@ Destroy any data you have, and rebuild the tables and indices the
library will need to actually function. Must be called after the
database is connected.
- $db->rebuild(); # [SFX: TOILET FLUSHING]
+ $db->rebuild(); # [SFX: TOILET FLUSHING]
=cut
sub rebuild {
- my $self = shift;
- my $dbh = $self->[DBH];
-
- warn(
- "++ You may see NOTICEs about implicit triggers being dropped added.\n",
- "++ They appear to be normal. Please inform us if they can be avoided.\n",
- );
-
- # Nodes.
- $dbh->do("DROP TABLE node CASCADE");
- $dbh->do("DROP SEQUENCE node_seq_seq");
- $dbh->do("CREATE SEQUENCE node_seq_seq");
- $dbh->do(
- <<' END'
- CREATE TABLE node (
- seq INTEGER DEFAULT nextval('node_seq_seq') NOT NULL,
- arc_seq INTEGER NOT NULL,
- val_key CHARACTER VARYING NOT NULL,
- val_text CHARACTER VARYING NOT NULL
- )
- END
- );
- $dbh->do("CREATE UNIQUE INDEX node_seq ON node USING BTREE (seq)");
- $dbh->do("CREATE INDEX node_arc ON node USING BTREE (arc_seq)");
- $dbh->do("CREATE UNIQUE INDEX node_val_key ON node USING BTREE (val_key)");
-
- # Arcs.
- $dbh->do("DROP TABLE arc CASCADE");
- $dbh->do("DROP SEQUENCE arc_seq_seq");
- $dbh->do("CREATE SEQUENCE arc_seq_seq");
- $dbh->do(
- <<' END'
- CREATE TABLE arc (
- seq INTEGER DEFAULT nextval('arc_seq_seq') NOT NULL,
- sub_seq INTEGER NOT NULL,
- prd_seq INTEGER NOT NULL,
- obj_seq INTEGER NOT NULL
- )
- END
- );
- $dbh->do("CREATE UNIQUE INDEX arc_seq ON arc USING BTREE (seq)");
- $dbh->do("CREATE INDEX arc_sub_seq ON arc USING BTREE (sub_seq)");
- $dbh->do("CREATE INDEX arc_prd_seq ON arc USING BTREE (prd_seq)");
- $dbh->do("CREATE INDEX arc_obj_seq ON arc USING BTREE (obj_seq)");
-
- # Referential integrity.
- $dbh->do(
- "ALTER TABLE node " .
- "ADD CONSTRAINT node_arc " .
- "FOREIGN KEY (arc_seq) " .
- "REFERENCES arc(seq) " .
- "MATCH FULL"
- );
-
- $dbh->do(
- "ALTER TABLE arc " .
- "ADD CONSTRAINT arc_sub " .
- "FOREIGN KEY (sub_seq) " .
- "REFERENCES arc(seq) " .
- "MATCH FULL"
- );
- $dbh->do(
- "ALTER TABLE arc " .
- "ADD CONSTRAINT arc_prd " .
- "FOREIGN KEY (prd_seq) " .
- "REFERENCES arc(seq) " .
- "MATCH FULL"
- );
- $dbh->do(
- "ALTER TABLE arc " .
- "ADD CONSTRAINT arc_obj " .
- "FOREIGN KEY (obj_seq) " .
- "REFERENCES arc(seq) " .
- "MATCH FULL"
- );
-
- # For referential integrity to work.
- $dbh->do("INSERT INTO arc VALUES (0, 0, 0, 0)");
-
- warn "++ End of the NOTICEs.\n";
+ my $self = shift;
+ my $dbh = $self->[DBH];
+
+ warn(
+ "++ You may see NOTICEs about implicit triggers being dropped added.\n",
+ "++ They appear to be normal. Please inform us if they can be avoided.\n",
+ );
+
+ # Nodes.
+ $dbh->do("DROP TABLE node CASCADE");
+ $dbh->do("DROP SEQUENCE node_seq_seq");
+ $dbh->do("CREATE SEQUENCE node_seq_seq");
+ $dbh->do(
+ <<' END'
+ CREATE TABLE node (
+ seq INTEGER DEFAULT nextval('node_seq_seq') NOT NULL,
+ arc_seq INTEGER NOT NULL,
+ val_key CHARACTER VARYING NOT NULL,
+ val_text CHARACTER VARYING NOT NULL
+ )
+ END
+ );
+ $dbh->do("CREATE UNIQUE INDEX node_seq ON node USING BTREE (seq)");
+ $dbh->do("CREATE INDEX node_arc ON node USING BTREE (arc_seq)");
+ $dbh->do("CREATE UNIQUE INDEX node_val_key ON node USING BTREE (val_key)");
+
+ # Arcs.
+ $dbh->do("DROP TABLE arc CASCADE");
+ $dbh->do("DROP SEQUENCE arc_seq_seq");
+ $dbh->do("CREATE SEQUENCE arc_seq_seq");
+ $dbh->do(
+ <<' END'
+ CREATE TABLE arc (
+ seq INTEGER DEFAULT nextval('arc_seq_seq') NOT NULL,
+ sub_seq INTEGER NOT NULL,
+ prd_seq INTEGER NOT NULL,
+ obj_seq INTEGER NOT NULL
+ )
+ END
+ );
+ $dbh->do("CREATE UNIQUE INDEX arc_seq ON arc USING BTREE (seq)");
+ $dbh->do("CREATE INDEX arc_sub_seq ON arc USING BTREE (sub_seq)");
+ $dbh->do("CREATE INDEX arc_prd_seq ON arc USING BTREE (prd_seq)");
+ $dbh->do("CREATE INDEX arc_obj_seq ON arc USING BTREE (obj_seq)");
+
+ # Referential integrity.
+ $dbh->do(
+ "ALTER TABLE node " .
+ "ADD CONSTRAINT node_arc " .
+ "FOREIGN KEY (arc_seq) " .
+ "REFERENCES arc(seq) " .
+ "MATCH FULL"
+ );
+
+ $dbh->do(
+ "ALTER TABLE arc " .
+ "ADD CONSTRAINT arc_sub " .
+ "FOREIGN KEY (sub_seq) " .
+ "REFERENCES arc(seq) " .
+ "MATCH FULL"
+ );
+ $dbh->do(
+ "ALTER TABLE arc " .
+ "ADD CONSTRAINT arc_prd " .
+ "FOREIGN KEY (prd_seq) " .
+ "REFERENCES arc(seq) " .
+ "MATCH FULL"
+ );
+ $dbh->do(
+ "ALTER TABLE arc " .
+ "ADD CONSTRAINT arc_obj " .
+ "FOREIGN KEY (obj_seq) " .
+ "REFERENCES arc(seq) " .
+ "MATCH FULL"
+ );
+
+ # For referential integrity to work.
+ $dbh->do("INSERT INTO arc VALUES (0, 0, 0, 0)");
+
+ warn "++ End of the NOTICEs.\n";
}
=head2 connect DSN, USERNAME, PASSWORD
@@ -464,18 +464,18 @@ Actually, the parameters to connect() are passed verbatim to
DBI->connect(). Returns a ThirdLobe::Database object that can be used
to interact with the database on a low level.
- my $dbh = ThirdLobe::Database->connect("dbi:pg:dbname=know");
+ my $dbh = ThirdLobe::Database->connect("dbi:pg:dbname=know");
=cut
sub connect {
- my $class = shift;
- my $dbh = DBI->connect(@_);
- die "Could not connect to database: ", $dbh->errstr() if $dbh->err();
+ my $class = shift;
+ my $dbh = DBI->connect(@_);
+ die "Could not connect to database: ", $dbh->errstr() if $dbh->err();
- my $self = bless [
- $dbh, # DBH
- ], $class;
+ my $self = bless [
+ $dbh, # DBH
+ ], $class;
}
=head2 DESTROY
@@ -486,11 +486,11 @@ from properly.
=cut
sub DESTROY {
- my $self = shift;
- if (defined $self->[DBH]) {
- $self->[DBH]->disconnect();
- $self->[DBH] = undef;
- }
+ my $self = shift;
+ if (defined $self->[DBH]) {
+ $self->[DBH]->disconnect();
+ $self->[DBH] = undef;
+ }
}
=head1 TODO
Please sign in to comment.
Something went wrong with that request. Please try again.