view release on metacpan or  search on metacpan

lib/App/Widget/DataTable.pm  view on Meta::CPAN

   $name = "get_data";
   $w = App::Widget::DataTable->new($name);
   print $w->html();

=cut

######################################################################
# CONSTANTS
######################################################################

######################################################################
# ATTRIBUTES
######################################################################
# {border}            = 0;
# {cellspacing}       = 2;
# {cellpadding}       = 0;
# {width}             = "";
# {bgcolor}           = "";
# {nowrap}            = "1";
# {font_face}         = "verdana,geneva,arial,sans-serif";
# {font_size}         = "-2";
# {font_color}        = "";
# {heading_bgcolor}   = "#cccccc";
# {heading_nowrap}    = 0;
# {heading_align}     = 0;
# {heading_valign}    = 0;
# {column_selectable} = 1;
# {row_selectable}    = 0;
# {row_single_selectable} = 0;
# {columns}           = [ "Name", "Address", "City", "State", "Country", "Home Phone" ];
# {headings}          = [ "Name", "Address", "City", "State", "Country", "Home Phone" ];
# {data}              = [ [ "Smith, Harold", "1215 Interloke Pass", "Jonesboro", "GA", "US", "770-603-1810" ],
#                         [ "Smith, Mike",   "1215 Interloke Pass", "Jonesboro", "GA", "US", "770-603-1811" ],
#                         [ "Smith, Sarah",  "1215 Interloke Pass", "Jonesboro", "GA", "US", "770-603-1812" ],
#                         [ "Smith, Ken",    "1215 Interloke Pass", "Jonesboro", "GA", "US", "770-603-1813" ],
#                         [ "Smith, Mary",   "1215 Interloke Pass", "Jonesboro", "GA", "US", "770-603-1814" ], ];
# {startrow}          = 1
# {maxrows}           = 20
# {scrollable}        = 0;
# {sortable}          = 0;
# {filterable}        = 0;
# {editable}          = 0;

# INPUTS FROM THE ENVIRONMENT

=head1 DESCRIPTION

This class is a <input type=submit> HTML element.
In the advanced configurations, it is rendered as an image button.

=cut

######################################################################
# INITIALIZATION
######################################################################

sub _init {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    $self->SUPER::_init(@_);
    $self->{table} = $self->{name} if (!$self->{table});

    $self->{context}->dbgprint("DataTable->init()")
        if ($App::DEBUG && $self->{context}->dbg(1));
}

######################################################################
# EVENTS
######################################################################

# Usage: $widget->handle_event($event, @args);
sub handle_event {
    &App::sub_entry if ($App::trace);
    my ($self, $wname, $event, @args) = @_;
    my ($name, $context, $colnum, $x, $y, $startrow, $maxrows, $width, $direction);

    #$self->clear_messages();

    $name = $self->{name};
    $self->{context}->dbgprint("DataTable($name)->handle_event($wname,$event,@args)")
        if ($App::DEBUG && $self->{context}->dbg(1));

    my $handled = 0;
    if ($wname eq "$name-view") {
        $self->set("mode","view");
        $self->delete("editdata");
        $handled = 1;
    }
    elsif ($wname eq "$name-edit") {
        $self->set("mode","edit");
        $handled = 1;
    }
    elsif ($wname eq "$name-next") {
        $startrow = $self->get("startrow",1,1);
        $maxrows  = $self->get("maxrows",20,1);
        $startrow += $maxrows;
        $self->set("startrow",$startrow);
        $handled = 1;
    }
    elsif ($wname eq "$name-prev") {
        $startrow = $self->get("startrow",1,1);
        $maxrows  = $self->get("maxrows",20,1);
        $startrow -= $maxrows;
        $startrow = 1 if ($startrow < 1);
        $self->set("startrow",$startrow);
        $handled = 1;
    }
    elsif ($wname eq "$name-save") {
        $self->save();
        $self->delete("editdata");
        $handled = 1;
    }
    elsif ($wname eq "$name-add") {
        $self->{context}->add_message("Add Rows: not yet implemented");
        $handled = 1;
    }
    elsif ($wname eq "$name-delete") {
        $self->{context}->add_message("Delete Rows: not yet implemented");
        $handled = 1;
    }
    elsif ($event eq "sort") {
        ($colnum, $direction) = @args;

        my ($columns, $directions, $order_by, $column, $i);
        $columns    = $self->get_columns();
        $column     = $columns->[$colnum];

        $order_by = $self->get("order_by") || $self->get("ordercols");   # ordercols is deprecated in favor of order_by
        if (defined $order_by) {
            $directions = $self->get("directions");
            $directions = [] if (!defined $directions);
            for ($i = 0; $i <= $#$order_by; $i++) {
                if ($order_by->[$i] eq $column) {
                    splice(@$order_by, $i, 1);     # delete the use of $column
                    splice(@$directions, $i, 1);    # delete the sort direction
                    last;
                }
            }
            unshift(@$order_by, $column);      # put it at the beginning
            unshift(@$directions, $direction);
        }
        else {
            $order_by = [ $column ];
            $directions = [ $direction ];
        }

        $self->set("order_by",$order_by);
        $self->set("directions",$directions);
        $handled = 1;
    }
    elsif ($wname =~ /-sort[0-9]*$/) {
        ($colnum, $x, $y) = @args;
        $context = $self->{context};
        $width = $context->widget($wname)->get("width");
        if ($x <= $width/2) {
            $handled = $self->handle_event($wname, "sort", $colnum, "UP");
        }
        else {
            $handled = $self->handle_event($wname, "sort", $colnum, "DOWN");
        }
    }
    else {
        $handled = $self->SUPER::handle_event(@_);
    }
    &App::sub_exit($handled) if ($App::trace);
    return($handled);
}

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

sub get_columns {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    my ($columns);
    $columns = $self->{columns};
    if (defined $columns && ref($columns) eq "") {
        $columns = [ $columns ];
        $self->set("columns", $columns);
    }
    if (!defined $columns) {
        my ($repository, $rep, $table);
        $repository = $self->{repository};
        $table      = $self->{table};
        $rep        = $self->{context}->repository($repository);
        if ($rep && $table) {
            $columns = $rep->get_column_names($table);
        }
    }
    $columns = [] if (!defined $columns || ref($columns) eq "");
    &App::sub_exit($columns) if ($App::trace);
    $columns;
}

sub get_headings {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    $self->{context}->dbgprint("DataTable->get_headings()")
        if ($App::DEBUG && $self->{context}->dbg(1));
    my ($table, $headings, $heading, $columns, $column, $lang);
    $table = $self->get("table");
    $columns = $self->get_columns();
    $headings = $self->get("headings");
    $lang = $self->{lang};
    my $column_attribs = $self->{column} || {};
    if (!defined $headings) {
        $headings = [];
        my ($repname, $context, $rep, $columnlabels);
        $repname = $self->get("repository");
        $context  = $self->{context};
        $rep = $context->repository($repname);
        $columnlabels = $rep->get_column_labels($table);
        foreach $column (@$columns) {
            $heading = $column_attribs->{$column}{label} || $columnlabels->{$column} || $column;
            $heading = $self->translate($heading, $lang) if (defined $lang);
            push(@$headings, $heading);
            $self->{context}->dbgprint("DataTable->get_headings(): column=$column(",$#$columns,") heading=$heading(",$#$headings,")")
                if ($App::DEBUG >= 6 && $self->{context}->dbg(6));
        }
    }
    $self->{context}->dbgprint("DataTable->get_headings(): columns=[", join(",", @{$self->get("columns",[])}), "]")
        if ($App::DEBUG && $self->{context}->dbg(1));