The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

#############################################################################
## $Id: Repository.pm 9914 2007-09-04 15:45:46Z spadkins $
#############################################################################

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

use App;
use App::ValueDomain;
@ISA = ( "App::ValueDomain" );

use strict;

=head1 NAME

App::ValueDomain - a set of values and their labels

=head1 SYNOPSIS

    use App;

    $context = App->context();
    $dom = $context->service("ValueDomain");
    $dom = $context->value_domain();

=head1 DESCRIPTION

A ValueDomain service represents a set of values and their labels.

=cut

#############################################################################
# METHODS
#############################################################################

=head1 Methods:

=cut

#############################################################################
# _load()
#############################################################################

=head2 _load()

The _load() method is called to get the list of valid values in a data
domain and the labels that should be used to represent these values to
a user.

    * Signature: $self->_load()
    * Signature: $self->_load($values_string)
    * Param:     $values_string    string
    * Return:    void
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage:

    $self->_load();

=cut

sub _load {
    &App::sub_entry if ($App::trace);
    my ($self, $values_string) = @_;
    my ($values, $labels, $needs_loading, $refresh_interval, $time);
    my ($method, $args, $rows, $row);

    if (!defined $values_string) {
        if (defined $self->{values_string_template}) {
            $values_string = $self->substitute($self->{values_string_template});
        }
        else {
            $values_string = "";
        }
    }

    $values = $self->{values};
    $labels = $self->{labels};

    $needs_loading = 0;

    # if this is a repository-based domain, and we have never loaded
    # the values/labels (or it's time to refresh them by loading them again)
    # then the values/labels indeed need loading
    my $repository  = $self->{repository};

    if (!defined $values || !defined $labels ||                     # never loaded them yet
        ($values_string eq "" && $self->{values_string}) ||         # asking for the whole domain, only subset loaded
        ($values_string ne "" && defined $self->{values_string} &&  # asking for a different subset than is loaded
         $values_string ne $self->{values_string})) {
        $needs_loading = 1;
    }
    else {
        $refresh_interval = $self->{refresh_interval};
        if (defined $refresh_interval && $refresh_interval ne "" && $refresh_interval >= 0) {
            if ($refresh_interval == 0) {
                $needs_loading = 1;
            }
            else {
                if (time() >= $self->{time} + $refresh_interval) {
                    $needs_loading = 1;
                }
            }
        }
    }

    if ($needs_loading) {
        my $context     = $self->{context};

        my $rep         = $context->repository($repository);
        my $table       = $self->substitute($self->{table});
        my $valuecolumn = $self->{valuecolumn};
        my $labelcolumn = $self->{labelcolumn};
        $labelcolumn = "" if ($labelcolumn eq $valuecolumn);
        my $params      = $self->{params} || {};
        my $sql         = $self->{sql};

        my ($key);
        my $subst_params = $self->substitute($params, undef, {undef_value => "NULL"});

        if (defined $values_string && $values_string ne "" && $values_string !~ /^:/) {
            my $values_string_columns = $self->{values_string_columns};
            if ($values_string_columns) {
                $values_string_columns = [split(/,/, $values_string_columns)] if (!ref($values_string_columns));
                my @values_string_values = split(/,/, $values_string);
                if ($#values_string_values > -1 && $#$values_string_columns == $#values_string_values) {
                    for (my $i = 0; $i <= $#$values_string_columns; $i++) {
                        $subst_params->{$values_string_columns->[$i]} = $values_string_values[$i];
                    }
                }
            }
            else {
                $subst_params->{$valuecolumn} = $values_string;
            }
        }

        if ($rep && $table && $valuecolumn && $params) {
            my @cols = ( $valuecolumn );
            push(@cols, $labelcolumn) if ($labelcolumn);
            my ($options);
            if ($self->{order_by}) {
                $options = { order_by => $self->{order_by} };
            }

            $rows   = $rep->get_rows($table, $subst_params, \@cols, $options);
            $values = [];
            $labels = {};
            foreach $row (@$rows) {
                push(@$values, $row->[0]);
                $labels->{$row->[0]} = $row->[1] if ($labelcolumn);
            }
            if ($self->{extra_values}) {
                my @each = @$values;
                my $extra_values = $self->{extra_values};
                my $extra_labels = $self->{extra_labels} || {};
                for (my $i = $#$extra_values; $i >= 0; $i--) {
                    if ($extra_values->[$i] eq "EACH") {
                        $key = join(",", @each) || -99999;
                        unshift(@$values, $key);
                        $labels->{$key} = $extra_labels->{EACH};
                    }
                    else {
                        $key = $extra_values->[$i];
                        unshift(@$values, $key);
                        $labels->{$key} = $extra_labels->{$key};
                    }
                }
            }
            $self->{values} = $values;
            $self->{labels} = $labels if ($labelcolumn);
            $time = time();
            $self->{time} = $time;
            $self->{values_string} = $values_string;
        }

        if ($sql) {
            my $vals = ($values_string eq '') ? undef : {values_string => $values_string};
            $sql = $self->substitute($sql, $vals, {undef_value => "NULL"});

            my $rows = $rep->_do($sql);
            foreach my $row (@$rows) {
                push(@$values, $row->[0]);
                $labels->{$row->[0]} = $row->[1];
            }

            $self->{values} = $values;
            $self->{labels} = $labels;
            $time = time();
            $self->{time} = $time;
        }
    }

    $values = [] if (! defined $values);
    $labels = {} if (! defined $labels);

    &App::sub_exit() if ($App::trace);
}

=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::Service>|App::Service>

=cut

1;