lib/App/SessionObject/RepositoryObjectSet.pm


#############################################################################
## $Id: RepositoryObjectSet.pm 9934 2007-09-11 18:04:00Z spadkins $
#############################################################################

package App::SessionObject::RepositoryObjectSet;
$VERSION = (q$Revision: 9934 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn

use App;
use App::Repository;
use App::SessionObject;

@ISA = ( "App::SessionObject" );

use strict;

=head1 NAME

App::SessionObject::RepositoryObjectSet - A set of repository objects described by a set of query parameters

=head1 SYNOPSIS

    use App::SessionObject::RepositoryObjectSet;

    ...

=cut

=head1 DESCRIPTION

A RepositoryObjectSet is a set of repository objects (i.e. rows in 
a database).

By using a RepositoryObjectSet instead of simply doing a query, you get
a variety of benefits.

 * session-level caching
 * find domains of given columns (get_column_values())
 * create unique and non-unique indexes of the object set based on
   groups of columns (get_index(), get_unique_index())
 * efficiently fetch single objects within the set or subsets of objects
   which share common values in a set of attributes

=cut

###########################################################################
# Support Routines
###########################################################################

sub _init {
    &App::sub_entry if ($App::trace);
    my ($self, $args) = @_;
    $self->SUPER::_init();
    my $table   = $self->{table} || die "table not defined";
    $self->_clear_cache_if_auto_params_changed() if ($self->{auto_params});   # sets params from auto_params
    $self->_clear_cache_if_auto_columns_changed() if ($self->{auto_columns}); # sets columns from auto_columns
    if (!$self->{columns} && !$self->{temporary}) {
        my $context = $self->{context};
        my $repname = $self->{repository};
        my $rep     = $context->repository($repname);
        $self->{columns} = $rep->_get_default_columns($table);
    }
    &App::sub_exit() if ($App::trace);
}

# This should only be relevant for temporary
sub set_objects {
    &App::sub_entry if ($App::trace);
    my ($self, $objects, $columns) = @_;
    if ($self->{temporary}) {
        $self->{objects} = $objects;
        delete $self->{index};
        delete $self->{unique_index};
        delete $self->{column_values};
        delete $self->{max_age_time};
        delete $self->{ext_summary};
        delete $self->{summary};
        if ($columns) {
            $self->{columns} = $columns;
        }
        elsif (!$self->{columns} && $#$objects > -1) {
            $columns = [ sort keys %{$objects->[0]} ];
            $self->{columns} = $columns;
        }
    }
    else {
        die "set_objects() is not allowed on a non-temporary object set";
    }
    &App::sub_exit() if ($App::trace);
}

sub _clear_cache {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    if (!$self->{temporary}) {
        delete $self->{objects};
        delete $self->{index};
        delete $self->{unique_index};
        delete $self->{column_values};
        delete $self->{max_age_time};
        delete $self->{ext_summary};
        delete $self->{summary};
    }
    &App::sub_exit() if ($App::trace);
}

sub _clear_cache_if_objects_expired {
    &App::sub_entry if ($App::trace);
    my ($self, $options) = @_;
    my $max_age = $options->{max_age};
    $max_age = $self->{max_age} if (!defined $max_age);
    if (defined $max_age && $self->{objects}) {
        my $max_age_time = $self->{max_age_time};
        my $time = time();
        if (defined $max_age_time && $max_age_time <= $time - $max_age) {
            $self->_clear_cache();
        }
    }
    &App::sub_exit() if ($App::trace);
}

sub _clear_cache_if_auto_params_changed {
    &App::sub_entry if ($App::trace);
    my ($self, $options) = @_;
    if (defined $self->{auto_params}) {
        my $newparams = $self->substitute($self->{auto_params});
        if (!$self->{params}) {
            $self->{params} = $newparams;
        }
        else {
            my $changed = 0;
            my $params = $self->{params};
            foreach my $var (keys %$newparams) {
                if ($params->{$var} ne $newparams->{$var}) {
                    $changed = 1;
                    last;
                }
            }
            if ($changed) {
                $self->{params} = $newparams;
                $self->_clear_cache();
            }
        }
    }
    &App::sub_exit() if ($App::trace);
}

sub _clear_cache_if_auto_columns_changed {
    &App::sub_entry if ($App::trace);
    my ($self, $options) = @_;
    if (defined $self->{auto_columns}) {
        my (@auto_columns, %column, $new_columns);
        my $context = $self->{context};
        foreach my $wname (split(/,/, $self->{auto_columns})) {
            $new_columns = $context->so_get($wname);
            if ($new_columns) {
                push(@auto_columns, split(/,/, $new_columns));
            }
        }
        if (!$self->{columns}) {
            $self->{columns} = \@auto_columns;
            $self->_clear_cache();
        }
    }
    &App::sub_exit() if ($App::trace);
}

sub set_params {
    &App::sub_entry if ($App::trace);
    my ($self, $params) = @_;
    $params ||= {};
    my $redefined = 0;
    my $self_params = $self->{params};
    if (!$self_params) {
        $redefined = 1;
    }
    else {
        my (%param_already_defined, $key);
        foreach $key (keys %$self_params) {
            $param_already_defined{$key} = 1;
            if ((! exists $params->{$key}) ||
                (! defined $params->{$key} && defined $self_params->{$key}) ||
                (defined $params->{$key} && ! defined $self_params->{$key}) ||
                (defined $params->{$key} && defined $self_params->{$key} && $params->{$key} ne $self_params->{$key})) {
                $redefined = 1;
            }
        }
        if (!$redefined) {
            foreach $key (keys %$params) {
                if (! exists $self_params->{$key}) {
                    $redefined = 1;
                }
            }
        }
    }
    if ($redefined) {
        $self->{params} = { %$params };
        $self->_clear_cache();
    }
    &App::sub_exit() if ($App::trace);
}

sub update_params {
    &App::sub_entry if ($App::trace);
    my ($self, $params) = @_;
    my $self_params = $self->{params};
    die "params must be set before update_params() is called" if (!$self_params);
    my $param_changed = 0;
    foreach my $key (keys %$self_params) {
        if (exists $params->{$key} &&
            $self_params->{$key} ne $params->{$key}) {
            $self_params->{$key} = $params->{$key};
            $param_changed = 1;
        }
    }
    if ($param_changed && $self->{objects}) {
        $self->_clear_cache();
    }
    &App::sub_exit() if ($App::trace);
}

sub _get_all_objects {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    my $objects = $self->{objects};
    if (!$objects) {
        if ($self->{temporary}) {
            $objects = [];
        }
        else {
            my $context = $self->{context};
            my $repname = $self->{repository};
            my $rep     = $context->repository($repname);
            my $table   = $self->{table} || die "table not defined";
            my $params  = $self->{params} || {};
            my $columns = $self->{columns};
            # Make a copy of $params so that if $db->get_objects() changes them,
            # it does not affect the cacheing aspects of the object set.
            $params = {%$params};
            $objects = $rep->get_objects($table, $params, $columns, {extend_columns => 1});
            $self->{objects}      = $objects;
            $self->{max_age_time} = time();
        }
    }
    &App::sub_exit($objects) if ($App::trace);
    return($objects);
}

###########################################################################
# Column Control
###########################################################################

sub set_columns {
    &App::sub_entry if ($App::trace);
    my ($self, $new_columns) = @_;
    $self->{columns} = $new_columns;
    $self->_clear_cache();
    &App::sub_exit() if ($App::trace);
}

sub include_columns {
    &App::sub_entry if ($App::trace);
    my ($self, $new_columns) = @_;
    my $columns = $self->{columns};
    if (!$columns) {
        my $repname = $self->{repository};
        my $context = $self->{context};
        my $rep = $context->repository($repname);
        my $table = $self->{table} || die "table not defined on object_set [$self->{name}]";
        $columns = $rep->_get_default_columns($table);
        $self->{columns} = $columns;
    }
    my (%colidx, $column_added, $column);
    for (my $i = 0; $i <= $#$columns; $i++) {
        $colidx{$columns->[$i]} = $i;
    }
    for (my $i = 0; $i <= $#$new_columns; $i++) {
        $column = $new_columns->[$i];
        if (! defined $colidx{$column}) {
            push(@$columns, $column);
            $colidx{$column} = $#$columns;
            $column_added = 1;
        }
    }
    if ($column_added) {
        $self->_clear_cache();
    }
    &App::sub_exit() if ($App::trace);
}

sub get_repository {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    my $context = $self->{context};
    my $repname = $self->{repository};
    my $rep     = $context->repository($repname);
    &App::sub_exit($rep) if ($App::trace);
    return($rep);
}

sub get_table {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    my $table = $self->{table};
    &App::sub_exit($table) if ($App::trace);
    return($table);
}

sub get_columns {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    my $columns = $self->{columns};
    &App::sub_exit($columns) if ($App::trace);
    return($columns);
}

sub get_key_columns {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    my $repname     = $self->{repository};
    my $context     = $self->{context};
    my $rep         = $context->repository($repname);
    my $table       = $self->{table} || die "table not defined";
    my $table_def   = $rep->get_table_def($table);
    my $column_defs = $table_def->{column};
    my $columns     = $self->{columns};
    if (!$columns) {
        $columns = $rep->_get_default_columns($table);
        $self->{columns} = $columns;
    }
    my (@key_columns, $column);
    for (my $i = 0; $i <= $#$columns; $i++) {
        $column = $columns->[$i];
        if ($column_defs->{$column}{is_key}) {
            push(@key_columns, $column);
        }
    }
    &App::sub_exit(\@key_columns) if ($App::trace);
    return(\@key_columns);
}

sub get_column_defs {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    my $context     = $self->{context};
    my $repname     = $self->{repository};
    my $rep         = $context->repository($repname);
    my $table       = $self->{table} || die "table not defined";
    my $table_def   = $rep->get_table_def($table);
    my $column_defs = $table_def->{column};
    &App::sub_exit($column_defs) if ($App::trace);
    return($column_defs);
}

###########################################################################
# Accessing individual objects
###########################################################################

sub get_index {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    my $options = (ref($_[0]) eq "HASH") ? shift : {};
    my $key_name = ref($_[0]) ? "" : shift;
    my $key_columns = shift;
    $key_name = join(",", @$key_columns) if (!$key_name && ref($key_columns) eq "ARRAY");
    $key_name ||= "ie1";

    $self->_clear_cache_if_auto_params_changed($options) if (defined $self->{auto_params});
    $self->_clear_cache_if_objects_expired($options) if ((defined $options->{max_age} || defined $self->{max_age}) && $self->{objects});

    my $index = $self->{index}{$key_name};
    if (!$index) {
        if ($self->{key}{$key_name}) {
            $key_columns = $self->{key}{$key_name};
        }
        die "no list of columns given or known for key [$key_name]" if (!$key_columns);
        my ($key);
        $index = {};
        my $objects = $self->_get_all_objects();
        foreach my $object (@$objects) {
            $key = join(",", @{$object}{@$key_columns});
            if ($index->{$key}) {
                push(@{$index->{$key}}, $object);
            }
            else {
                $index->{$key} = [ $object ];
            }
        }
        $self->{index}{$key_name} = $index;
    }
    &App::sub_exit($index) if ($App::trace);
    return($index);
}

# $self->get_unique_index($key_columns);
# $self->get_unique_index($key_name, $key_columns);
# $self->get_unique_index($key_name);
sub get_unique_index {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    my $options = (ref($_[0]) eq "HASH") ? shift : {};
    my $key_name = ref($_[0]) ? "" : shift;
    my $key_columns = shift;
    $key_name = join(",", @$key_columns) if (!$key_name && ref($key_columns) eq "ARRAY");
    $key_name ||= "ak1";

    $self->_clear_cache_if_auto_params_changed($options) if (defined $self->{auto_params});
    $self->_clear_cache_if_objects_expired($options) if ((defined $options->{max_age} || defined $self->{max_age}) && $self->{objects});

    my $unique_index = $self->{unique_index}{$key_name};
    if (!$unique_index) {
        if ($self->{key}{$key_name}) {
            $key_columns = $self->{key}{$key_name};
        }
        die "no list of columns given or known for key [$key_name]" if (!$key_columns);
        my ($key);
        $unique_index = {};
        my $objects = $self->_get_all_objects();
        foreach my $object (@$objects) {
            $key = join(",", @{$object}{@$key_columns});
            $unique_index->{$key} = $object;
        }
        $self->{unique_index}{$key_name} = $unique_index;
    }
    &App::sub_exit($unique_index) if ($App::trace);
    return($unique_index);
}

sub get_summary {
    &App::sub_entry if ($App::trace);
    my ($self, $key_columns, $options) = @_;
    $key_columns = [] if (!$key_columns);
    my $key_name = join(",", @$key_columns);

    $self->_clear_cache_if_auto_params_changed($options) if (defined $self->{auto_params});
    $self->_clear_cache_if_objects_expired($options) if ((defined $options->{max_age} || defined $self->{max_age}) && $self->{objects});

    my $summary = $self->{summary}{$key_name};
    if (!$summary) {
        $summary = {};
        my $rep          = $self->get_repository();
        my $table        = $self->get_table();
        my $index        = $self->get_index($key_columns);
        my $columns      = $self->get_columns();
        my ($objects, $ext_summaries, %options, $summarized_rows);
        foreach my $key (keys %$index) {
            $objects = $index->{$key};
            $ext_summaries    = {};
            %options          = ( ext_summaries => $ext_summaries );
            $summarized_rows  = $rep->summarize_rows($table, $objects, $columns, $key_columns, \%options);
            $self->{ext_summary}{$key_name}{$key} = $ext_summaries;
            $summary->{$key} = $summarized_rows->[0];
        }
        $self->{summary}{$key_name} = $summary;
    }
    &App::sub_exit($summary) if ($App::trace);
    return($summary);
}

sub get_ext_summary {
    &App::sub_entry if ($App::trace);
    my ($self, $key_columns, $options) = @_;
    $key_columns = [] if (!$key_columns);
    my $key_name = join(",", @$key_columns);

    $self->_clear_cache_if_auto_params_changed($options) if (defined $self->{auto_params});
    $self->_clear_cache_if_objects_expired($options) if ((defined $options->{max_age} || defined $self->{max_age}) && $self->{objects});

    my $ext_summary = $self->{ext_summary}{$key_name};
    if (!$ext_summary) {
        $self->get_summary($key_columns);
        $ext_summary = $self->{ext_summary}{$key_name};
    }
    &App::sub_exit($ext_summary) if ($App::trace);
    return($ext_summary);
}

sub get_column_values {
    &App::sub_entry if ($App::trace);
    my ($self, $column, $options) = @_;

    $self->_clear_cache_if_auto_params_changed($options) if (defined $self->{auto_params});
    $self->_clear_cache_if_objects_expired($options) if ((defined $options->{max_age} || defined $self->{max_age}) && $self->{objects});

    my $values = $self->{column_values}{$column};
    if (!$values) {
        $values = [];
        my $objects = $self->_get_all_objects();
        my (%count, $value);
        foreach my $object (@$objects) {
            $value = $object->{$column};
            if (!$count{$value}) {
                $count{$value} = 1;
                push(@$values, $value);
            }
            else {
                $count{$value} ++;
            }
        }
        $self->{column_values}{$column} = $values;
    }
    &App::sub_exit($values) if ($App::trace);
    return($values);
}

# $self->get_object($options, $key, $key_columns);
# $self->get_object($key, $key_columns);
# $self->get_object($key, $key_name, $key_columns);
# $self->get_object($key, $key_name);
sub get_object {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    my $options = (ref($_[0]) eq "HASH") ? shift : {};
    my $key = shift;
    my $key_name = ref($_[0]) ? "" : shift;
    my $key_columns = shift;
    $key_name = join(",", @$key_columns) if (!$key_name && ref($key_columns) eq "ARRAY");
    $key_name ||= "ak1";

    $self->_clear_cache_if_auto_params_changed($options) if (defined $self->{auto_params});
    $self->_clear_cache_if_objects_expired($options) if ((defined $options->{max_age} || defined $self->{max_age}) && $self->{objects});

    my $unique_index = $self->get_unique_index($key_name, $key_columns);
    my $object = $unique_index->{$key};
    &App::sub_exit($object) if ($App::trace);
    return($object);
}

# $self->get_objects($key, $options, $key_name);
# $self->get_objects($key, $key_columns);
# $self->get_objects($key, $key_name, $key_columns);
# $self->get_objects($key, $key_name);
sub get_objects {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    my $options = (ref($_[0]) eq "HASH") ? shift : {};
    my $key = shift;
    die "key not scalar" if (ref($key));
    my $key_name = ref($_[0]) ? "" : shift;
    my $key_columns = shift;
    $key_name = join(",", @$key_columns) if (!$key_name && ref($key_columns) eq "ARRAY");
    $key_name ||= "ie1";

    $self->_clear_cache_if_auto_params_changed($options) if (defined $self->{auto_params});
    $self->_clear_cache_if_objects_expired($options) if ((defined $options->{max_age} || defined $self->{max_age}) && $self->{objects});

    my ($objects);
    if ($key) {
        my $index = $self->get_index($key_name, $key_columns);
        $objects = $index->{$key} || [];
    }
    else {
        $objects = $self->_get_all_objects();
    }
    &App::sub_exit($objects) if ($App::trace);
    return($objects);
}

=head1 ACKNOWLEDGEMENTS

 * Author:  Stephen Adkins <spadkins@gmail.com>
 * License: This is free software. It is licensed under the same terms as Perl itself.

=head1 SEE ALSO

L<C<App::Context>|App::Context>,
L<C<App::Repository>|App::Repository>

=cut

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)