238 lines
9.3 KiB
Perl
238 lines
9.3 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::SQL::Table
|
|
# Author: Jason Rhinelander
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: Rebuild.pm,v 1.10 2005/04/06 23:11:08 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description:
|
|
# This goes hand in hand with GT::SQL::Tree and is very useful in
|
|
# turning an existing table without the root, and/or depth columns
|
|
# into a GT::SQL::Tree-compatible format.
|
|
#
|
|
package GT::SQL::Tree::Rebuild;
|
|
# ===============================================================
|
|
use strict;
|
|
use vars qw/$DEBUG $VERSION $ERROR_MESSAGE @ISA $AUTOLOAD/;
|
|
|
|
use constants TREE_COLS_ROOT => 0,
|
|
TREE_COLS_FATHER => 1,
|
|
TREE_COLS_DEPTH => 2;
|
|
|
|
@ISA = qw/GT::SQL::Base/;
|
|
$DEBUG = 0;
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
|
|
$ERROR_MESSAGE = 'GT::SQL';
|
|
|
|
# New returns a GT::SQL::Tree::Rebuild object when you can pass to GT::SQL::Tree.
|
|
# When you are adding a tree to an existing table, but the table does not have
|
|
# the root and/or depth columns, you get a Rebuild object, then pass it to
|
|
# ->add_tree so that your tree can be built anyway.
|
|
# You need to call new with the following options:
|
|
# table => $Table_object
|
|
# missing_root => sub { ... }, # Only if you are missing the root. The code reference should return the pk of the root.
|
|
# missing_depth => 1, # Only if you are missing the depth. The code reference should return the depth of the node.
|
|
# missing_father => 1, # Only if you are missing the father. The code reference should return the pk of the father.
|
|
# cols => [...], # The columns you want %row (discussed below) to contain
|
|
#
|
|
# The code references are passed two arguments:
|
|
# \%row, # A row from the table. If using the cols option, it will only have those columns.
|
|
# $table_object, # This is the same object you pass to new()
|
|
# \%all # This is a hash reference of all rows; each key is a primary key, each value the row. This may or may not be of use to you.
|
|
#
|
|
# For depth, %all will have root and father ids set, for roots father ID's will be set.
|
|
#
|
|
# NOTE: The father, root, and depth columns must exist beforehand.
|
|
sub new {
|
|
my $this = shift;
|
|
my $opts = $this->common_param(@_) or return $this->error(BADARGS => FATAL => '$obj->new(HASH or HASH REF)');
|
|
|
|
my $self = bless {}, $this;
|
|
|
|
$self->{table} = $opts->{table} or return $self->error(BADARGS => FATAL => '$obj->new({ ... table => $table_obj ... })');
|
|
for (qw(missing_root missing_depth missing_father)) {
|
|
next unless exists $opts->{$_};
|
|
$self->{$_} = $opts->{$_};
|
|
ref $self->{$_} eq 'CODE' or return $self->error(BADARGS => FATAL => '$obj->new({ ... ' . $_ . ' => sub { ... } ... })');
|
|
}
|
|
$self->{cols} = $opts->{cols} if $opts->{cols};
|
|
$self->{cols} = [$self->{cols}] if $self->{cols} and not ref $self->{cols};
|
|
$self->{cols} ||= [];
|
|
$self->{order_by} = $opts->{order_by} if $opts->{order_by};
|
|
|
|
$self->{missing_root} or $self->{missing_depth} or $self->{missing_father} or return $self->error(BADARGS => FATAL => 'At least one of "missing_root", "missing_depth", or "missing_father" must be passed to $obj->new({ ... })');
|
|
|
|
$self->{_debug} = $opts->{debug} || $DEBUG || 0;
|
|
|
|
$self;
|
|
}
|
|
|
|
# Called internally by the GT::SQL::Tree object. This does all the calculations.
|
|
# Note that this only rebuilds the table itself, GT::SQL::Tree->create will still
|
|
# have to create its tree table.
|
|
sub _rebuild {
|
|
my ($self, $pk, $root_col, $father_col, $depth_col) = @_;
|
|
my $table = $self->{table};
|
|
|
|
my $count = $table->count();
|
|
for (my $i = 0; $i < $count; $i += 10000) {
|
|
$table->select_options("ORDER BY $self->{order_by}") if exists $self->{order_by};
|
|
$table->select_options("LIMIT 10000" . ($i ? " OFFSET $i" : ""));
|
|
my $sth = $table->select(@{$self->{cols}});
|
|
while (my $row = $sth->fetchrow_hashref) {
|
|
my %update;
|
|
if ($self->{missing_father}) {
|
|
my $father_id = $self->{missing_father}->($row, $table);
|
|
$update{$father_col} = $father_id unless $row->{$father_col} == $father_id;
|
|
$row->{$father_col} = $father_id;
|
|
}
|
|
if ($self->{missing_root}) {
|
|
my $root_id = $self->{missing_root}->($row, $table);
|
|
$update{$root_col} = $root_id unless $row->{$root_col} == $root_id;
|
|
$row->{$root_col} = $root_id;
|
|
}
|
|
if ($self->{missing_depth}) {
|
|
my $depth = $self->{missing_depth}->($row, $table);
|
|
$update{$depth_col} = $depth unless $row->{$depth_col} == $depth;
|
|
$row->{$depth_col} = $depth;
|
|
}
|
|
|
|
$table->update(\%update, { $pk => $row->{$pk} }) if keys %update; # If the new value(s) is/are 0, like the default value(s), %update will be empty
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::SQL::Tree::Rebuild - Helps to turn a table into one usable by GT::SQL::Tree.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use GT::SQL::Tree;
|
|
use GT::SQL::Tree::Rebuild;
|
|
|
|
my $rebuild = GT::SQL::Tree::Rebuild->new(
|
|
table => $DB->table('MyTable'),
|
|
missing_root => \&root_code,
|
|
missing_father => \&father_code,
|
|
missing_depth => \&depth_code,
|
|
order_by => 'column_name'
|
|
);
|
|
|
|
$DB->editor('MyTable')->add_tree(root => $root_col, father => $father_col, depth => $depth_col, rebuild => $rebuild);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
GT::SQL::Tree::Rebuild is designed to go hand-in-hand with GT::SQL::Tree and
|
|
aids in turning an existing table into one with the neccessary root, father and
|
|
depth columns needed by GT::SQL::Tree.
|
|
|
|
The main purpose is to do a one-shot conversion of a table to make it compatible
|
|
with GT::SQL::Tree.
|
|
|
|
=head2 new - Create a Rebuild object
|
|
|
|
There is only one method that is called - new. You pass the arguments needed
|
|
and get back a GT::SQL::Tree::Rebuild object. This object should then be passed
|
|
into GT::SQL::Tree->create (typically via C<$editor-E<gt>add_tree()>)
|
|
|
|
new() takes a hash with up to 4 argument pairs: "table" (required), and one or
|
|
more of "missing_root", "missing_father", or "missing_depth". The values are
|
|
explained below.
|
|
|
|
=over 4
|
|
|
|
=item table
|
|
|
|
Required. You specify the table object for the table to rebuild. For example, if
|
|
you are going to add a tree to the "Category" table, you provide the "Category"
|
|
table object here.
|
|
|
|
=item cols
|
|
|
|
By default, an entire row will be returned. To speed up the process and lower
|
|
the memory usage, you can use the C<cols> option, which specifies the columns to
|
|
select for $row. It is recommended that you only select columns that you need as
|
|
doing so will definately save time and memory.
|
|
|
|
=item missing_father, missing_root, missing_depth
|
|
|
|
Each of these arguments takes a code reference as its value. The arguments to
|
|
the code references are as follows:
|
|
|
|
=over 4
|
|
|
|
=item $row
|
|
|
|
The first argument is a hash reference of the row being examined. Your job, in
|
|
the code reference, is to examine $row and determine the missing value,
|
|
depending on which code reference is being called. missing_root needs to return
|
|
the root_id for this row; missing_father needs to return the father_id, and the
|
|
missing_depth code reference should return the depth for the row.
|
|
|
|
=item $table
|
|
|
|
The second argument passed to the code references is the same table object that
|
|
you pass into new(), which you can select from if neccessary.
|
|
|
|
=back
|
|
|
|
=item missing_father
|
|
|
|
The C<missing_father> code reference is called first - before C<missing_root>
|
|
and C<missing_depth>. The code reference is called as described above and should
|
|
return the ID of the father of the row passed in. A false return (0 or undef) is
|
|
interpreted as meaning that this is a root and therefore has no father.
|
|
|
|
=item missing_root
|
|
|
|
C<missing_root> has to return the root of the row passed in. This is called
|
|
after C<missing_father>, so the $row will contain whatever you returned in
|
|
C<missing_father> in the father ID column. Of course, this only applies if using
|
|
both C<missing_root> and C<missing_father>.
|
|
|
|
=item missing_depth
|
|
|
|
C<missing_depth> has to return the depth of the row passed in. This is called
|
|
last, so if you are also using C<missing_father> and/or C<missing_root>, you
|
|
will have whatever was returned by those code refs available in the $row.
|
|
|
|
=item order_by
|
|
|
|
The query done to retrieve records can be sorted using the C<order_by> option.
|
|
It should be anything valid for "ORDER BY _____". Often it can be useful to have
|
|
your results returned in a certain order - for example:
|
|
order_by => 'depth_column ASC'
|
|
would insure that parents come before roots. Of course, this example wouldn't
|
|
work if you are using "missing_depth" since none of the depth values will be
|
|
set.
|
|
|
|
=back
|
|
|
|
Once you have a GT::SQL::Tree::Rebuild object, you should pass it into
|
|
C<GT::SQL::Tree-E<gt>create> (which typically involves passing it into
|
|
C<$editor-E<gt>add_tree()>, which passed it through). Before calculating the
|
|
tree, GT::SQL::Tree will call on the rebuild object to reproduce the father,
|
|
root, and/or depth columns (whichever you specified).
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: Rebuild.pm,v 1.10 2005/04/06 23:11:08 jagerman Exp $
|
|
|
|
=cut
|