view release on metacpan or  search on metacpan

lib/Gtk2/Ex/Datasheet/DBI.pm  view on Meta::CPAN

# (C) Daniel Kasak: dan@entropy.homelinux.org
# See COPYRIGHT file for full license

# See 'man Gtk2::Ex::Datasheet::DBI' for full documentation ... or of course continue reading

package Gtk2::Ex::Datasheet::DBI;

use strict;

#use warnings;
no warnings;

use Data::Dumper;

use Glib qw/TRUE FALSE/;
use Gtk2::Pango;

use Gtk2::Ex::Dialogs (
                                        destroy_with_parent     => TRUE,
                                        modal                   => TRUE,
                                        no_separator            => FALSE
);

# Record Status Indicators
use constant {
                                        UNCHANGED               => 0,
                                        CHANGED                 => 1,
                                        INSERTED                => 2,
                                        DELETED                 => 3,
                                        LOCKED                  => 4
};

# Record Status column
use constant {
                                        STATUS_COLUMN           => 0
};

BEGIN {
    $Gtk2::Ex::DBI::Datasheet::VERSION                          = '2.1';
}

sub new {
    
    my ( $class, $req ) = @_;
    
    # Assemble object from request
    my $self = {
        dbh                 => $$req{dbh},                          # A database handle
        primary_key         => $$req{primary_key},                  # The primary key ( needed for inserts / updates )
        schema              => $$req{schema},                       # Database schema ( not required for MySQL )
        search_path         => $$req{search_path},                  # Schema search paths ( not required for MySQL )
        sql                 => $$req{sql},                          # A hash of SQL related stuff
        treeview            => $$req{treeview},                     # A Gtk2::Treeview to connect to
        footer_treeview     => $$req{footer_treeview},              # A Gtk2::Treeview to connect to ( for the footer )
        vbox                => $$req{vbox},                         # A vbox to create treeview(s) in
        footer              => $$req{footer},                       # A boolean to activate the footer treeview
        fields              => $$req{fields},                       # Field definitions
        column_info         => $$req{column_info} || undef,         # 'Faked' column_info
        multi_select        => $$req{multi_select},                 # Boolean to enable multi selection mode
        column_sorting      => $$req{column_sorting} || 0,          # Boolean to activate ( incomplete ) column sorting
        read_only           => $$req{read_only},                    # Boolean to indicate read-only mode
        before_apply        => $$req{before_apply},                 # Code that runs *before* each *record is applied
        on_apply            => $$req{on_apply},                     # Code that runs *after* each *record* is applied
        on_row_select       => $$req{on_row_select},                # Code that runs when a row is selected
        on_changed          => $$req{on_changed},                   # Code that runs when a record is changed ( any column )
        after_size_allocate	=> $$req{after_size_allocate} || undef, # Code that runs after the columns have responded to a size_allocate
        dump_on_error       => $$req{dump_on_error},                # Boolean to dump SQL command on DBI error
        friendly_table_name => $$req{friendly_table_name},          # Table name to use when issuing GUI errors
        custom_changed_text => $$req{custom_changed_text} || undef, # Text ( including markup ) to use in GUI questions when changes need to be applied
        data_lock_field     => $$req{data_lock_field} || undef,     # A field ( sql fieldname ) to use as a data-driven lock ( positive values will lock the record )
        quiet               => $$req{quiet} || 0                    # Boolean to supress non-fatal warnings
    };
    
    # Sanity checks ...
    if ( ! $self->{dbh} ) {
        die "Gtk2::Ex::Datasheet::DBI constructor missing a dbh!";
    }
    
    if ( ! $self->{treeview} && ! $self->{vbox} ) {
        die "Gtk2::Ex::Datasheet::DBI constructor requires either a treeview or a vbox!";
    }
    
    if ( $self->{treeview} && $self->{vbox} ) {
        die "You passed BOTH a treeview AND a vbox. Use one or the other!";
    }
    
    if ( $self->{sql} ) {
        if ( exists $self->{sql}->{pass_through} ) {
            $self->{read_only} = TRUE;
        } elsif ( ! ( exists $self->{sql}->{select} && exists $self->{sql}->{from} ) ) {
            die "Gtk2::Ex::DBI constructor missing a complete sql definition!\n"
                . "You either need to specify a pass_through key ( 'pass_through' )\n"
                . "or BOTH a 'select' AND and a 'from' key\n";
        }
    }
    
    bless $self, $class;
    
    my $legacy_warnings;
    
    # Reconstruct sql object if needed
    if ( $$req{sql_select} || $$req{table} || $$req{sql_where} || $$req{sql_order_by} ) {
        
        # Strip out SQL directives
        if ( $$req{sql_select} ) {
            $$req{sql_select}           =~ s/^select //i;
        }
        if ( $$req{table} ) {
            $$req{table}                =~ s/^from //i;
        }
        if ( $$req{sql_where} ) {
            $$req{sql_where}            =~ s/^where //i;
        }
        if ( $$req{sql_order_by} ) {