First pass at adding key files
This commit is contained in:
		
							
								
								
									
										237
									
								
								site/slowtwitch.com/cgi-bin/articles/GT/SQL/Tree/Rebuild.pm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										237
									
								
								site/slowtwitch.com/cgi-bin/articles/GT/SQL/Tree/Rebuild.pm
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,237 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# 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
 | 
			
		||||
		Reference in New Issue
	
	Block a user