view release on metacpan or  search on metacpan

Tree/Numbered/DB.pm  view on Meta::CPAN

    my %prntnums = map {$_->[0] => 1} @parents;
    delete $prntnums{0}; # or endless recursion...

    # TO DO: make order-by a user choice instead of hard-coded.
    my $sth = $dbh->prepare("select $cols->{serial_col}" . $extra . 
			    " from $table where $cols->{parent_col}=?" .
			    " order by $cols->{serial_col}");
    $sth->execute(0);
    my $root = $sth->fetchrow_hashref;

    $tree->{_Serial} = $root->{$tree->getMapping('_Serial')};
    foreach my $field ($tree->getFieldNames) {
	$tree->setField($field, $root->{$tree->getMapping($field)});
    }
    $tree->recursiveTreeBuild($sth, $cols, %prntnums);

    return $tree;
}

sub recursiveTreeBuild {
    my ($self, $sth, $cols, %prntnums) = @_;
    my $serial = $self->{_Serial};

    $sth->execute(($serial));
    my %rows = %{$sth->fetchall_hashref($self->getMapping('_Serial'))};
    
    foreach my $row (keys %rows) {
	# Note that the mappings for #self are the same as those of $newNode.
	my %values = map { $_, $rows{$row}->{$self->getMapping($_)} } 
	$self->getFieldNames;
	$values{NoWrite} = 1;

	my $newNode = $self->append(%values);
	$newNode->{_Serial} = $row;

	next unless (delete $prntnums{$row});
	$newNode->recursiveTreeBuild($sth, $cols, %prntnums);
    }
}

# <delete> deletes the item pointed to by the cursor.
# The curser is not changed, which means it effectively moves to the next item.
# However it does change to be just after the end if it is already there,
# so you won't get an overflow.
# Arguments: None.
# Returns: The deleted item or undef if none was deleted.
#          Note that the returned item is invalid since it's deleted from its 
#          table.

sub delete {
    my $self = shift;
    my $deleted = $self->SUPER::delete;

    if ($deleted) { 
	$deleted->{Statements}->{delete}->execute($deleted->{_Serial}); 
    }
    return $deleted;
}

# <update> updates the database when something changes.
sub update {
    my $self = shift;
    my @values = (map { $self->getField($_) } 
		  @{ $self->getFieldNames } );
    $self->{Statements}->{update}->execute(@values, $self->getNumber);
}

# <truncate> removes the entire table tied to the tree. Kills the 
#  data structure.
# Arguments: None.
# Returns: Nothing.

sub truncate {
    my $self = shift;
    $self->{Statements}->{truncate}->execute;
    delete $self->{keys %$self}; # Suicide.
}

# <revert> re-blesses the tree into the parent class, losing DB Tie.
# Arguments: None.
# Returns: Nothing.

sub revert {
    my $self = shift;
    my $keep_data = shift;

    # Remove data specific to this class:
    unless ($keep_data) {
	delete $self->{Source};
	delete $self->{SourceName};
	delete $self->{Statements};
	delete $self->{Map};
    }
    $_->revert foreach (@{ $self->{Items} });

    return bless $self, $ISA[0];
}

#*******************************************************************
# Field <-> DB mappings

# <_addMapping> adds a mapping to a field if there isn't one already.
#  You are allowed to add mappings to nonexistent fields.
# Arguments: $field - field name.
#            $map - collumn name to be mapped to the field.
# Returns: map name on success, undef otherwise.

sub _addMapping {
    my $self = shift;
    my ($field, $map) = @_;

    return $self->{Map}->{$field} = $map unless ($self->{Map}->{$field});
    return undef;
}

sub _removeMapping {
    my $self = shift;
    my $field = shift;
    delete $self->{Map}->{$field};
}