view release on metacpan or  search on metacpan

lib/Gtk3/Ex/DBI/Form.pm  view on Meta::CPAN

                    . " ... Defaulting to READ-ONLY mode ...\n" );
            }
            $self->{read_only} = TRUE;
        }
        
    } else {
        
        if ( $sth ) {
            while ( my $column_info_row = $sth->fetchrow_hashref ) {
                # Loop through the list of columns from the database, and
                # add only columns that we're actually dealing with
                for my $fieldname ( keys %{$self->{sql_to_widget_map}} ) {
                    if ( $self->{force_upper_case_fields} ) {
                        if ( uc($column_info_row->{COLUMN_NAME}) eq ( $fieldname ) ) {
                            # Note that we want to store this against the fieldname and NOT the sql_fieldname
                            $self->{column_info}->{ $self->{sql_to_widget_map}->{$fieldname} } = $column_info_row;
                            last;
                        }
                    } else {
                        if ( $column_info_row->{COLUMN_NAME} eq ( $fieldname ) ) {
                            # Note that we want to store this against the fieldname and NOT the sql_fieldname
                            $self->{column_info}->{ $self->{sql_to_widget_map}->{$fieldname} } = $column_info_row;
                            last;
                        }
                    }
                }
            }
        }
        
    }
    
    # Make sure we've got the primary key in the widgets hash and the sql_to_widget_map hash
    # It will NOT be here unless it's been specified in the SQL select string or the widgets hash already
    # Note that we test the sql_to_widget_map, and NOT the widgets hash, as we don't know what
    # the widget might be called, but we DO know what the name of the key in the sql_to_widget_map
    # should be
    foreach my $primary_key ( @{$self->{primary_keys}} ) {
        if ( ! exists $self->{sql_to_widget_map}->{ $primary_key } ) {
            $self->{widgets}->{ $primary_key } = {};
            $self->{sql_to_widget_map}->{ $primary_key } = $primary_key;
        }
        if ( $self->{dont_update_keys} ) {
            $self->{widgets}->{ $primary_key }->{dont_update} = 1;
        }
    }
    
    # If things failed above, we mightn't have a $sth to finish, so
    # check we do first ...
    if ( $sth ) {
        $sth->finish;
    }
    
    if ( ! $self->{skip_query} ) {
        $self->query;
    }
    
    # We connect a few little goodies to various widgets ...
    
    # - Connect our 'changed' method to whatever signal each widget emits when it's 'changed'
        
    # - Use the populate-popup signal of Gtk3::Entry widgets to add the 'find' menu item
    
    # - Connect to the 'key-press-event' signal of various widgets to move the focus along
    # ( ie as if the TAB key was pressed )
    
    # We also keep an array of widgets and signal ids so that we can disconnect all signal handlers
    # and cleanly destroy ourselves when requested
    
    # We also set up input / output formatters based on widget ( ie $self->{widgets} )
        
    # Set up some defaults for different widget types
    foreach my $fieldname ( keys %{$self->{widgets}} ) {
    
        # Get hold of the widget def ...
        my $widget_def = $self->{widgets}->{$fieldname};
        
        if ( exists $widget_def->{number} ) {
            
            # Properties of the number format:
            # - decimals                - number of decimal places
            # - decimal_fill            - whether to pad decimals out to the number of decimals
            # - separate_thousands        - whether to separate thousands groups with a comma
            # - currency                - whether to apply currency formatting
            
            # Set some defaults for properties that haven't been specified ...
            
            if ( ! exists $widget_def->{number}->{decimal_fill} ) {
                $widget_def->{number}->{decimal_fill} = TRUE;
            }
            
            if ( ! exists $widget_def->{number}->{separate_thousands} ) {
                $widget_def->{number}->{separate_thousands} = TRUE;
            }
            
            # If this is a currency widget, default to 2 decial places
            if ( exists $widget_def->{currency} && $widget_def->{currency} && ! exists $widget_def->{number}->{decimals} ) {
                $widget_def->{number}->{decimals} = 2;
            }
            
        }
        
        my @widgets;
        my $this_widget = $self->get_widget( $fieldname );
        
        if ( $this_widget ) {
            push @widgets, $this_widget;
        }
        
        # Now we've either got nothing, or 1 widget in an array, or a number of widgets in an array
        foreach my $widget ( @widgets ) {
            
            my @signals;
            my $type = (ref $widget);
            
            # To aid in debugging, I first push these onto a temporary array ...
            if ( $type eq "Gtk3::Calendar" ) {
                
                push @signals, $widget->signal_connect_after(
                    day_selected =>                       sub { $self->changed( $fieldname ) } );
                
            } elsif ( $type eq "Gtk3::ToggleButton"
                   || $type eq "Gtk3::RadioButton"
            ) {
                
                push @signals, $widget->signal_connect_after(
                    toggled =>              sub { $self->changed( $fieldname ) } );
                
            } elsif ( $type eq "Gtk3::TextView" || $type eq "Gtk3::SourceView::View" ) {
                
                # In this case, we don't connect to the widget, but to the widget's buffer ...
                # ... so we swap the buffer into $widget, so we can disconnect our signal later
                $widget = $widget->get_buffer;
                push @signals, $widget->signal_connect_after(
                    changed =>              sub { $self->changed( $fieldname ) } );
                   
            } elsif ( $type eq "Gtk3::CheckButton" ) {
                
                push @signals, $widget->signal_connect_after(
                    toggled =>              sub { $self->changed( $fieldname ) } );
                
            } elsif ( $type eq "Gtk3::Entry" ) {
                
                push @signals, $widget->signal_connect_after(
                    changed =>              sub { $self->changed( $fieldname ) } );
                push @signals, $widget->signal_connect_after(
                    'populate-popup' =>     sub { $self->build_entry_right_click_menu(@_) } );
                push @signals, $widget->signal_connect(
                    'activate' => sub { $self->{window}->child_focus('tab-forward') } );
                
            } elsif ( $type eq "Gtk3::Combo" ) {
                
                push @signals, $widget->signal_connect_after(
                    'button-press' =>       sub { $self->on_combo_button_press_event(@_) } );
                
            } elsif ( $type eq "Gtk3::SpinButton" ) {
                
                push @signals, $widget->signal_connect_after(
                    changed =>              sub { $self->changed( $fieldname ) } );
                push @signals, $widget->signal_connect_after(
                    'populate-popup' =>     sub { $self->build_entry_right_click_menu(@_) } );
                push @signals, $widget->signal_connect(
                    'key-press-event' =>    sub { $self->process_entry_keypress(@_) } );
                
            } else {
                
                push @signals, $widget->signal_connect_after(
                    changed =>              sub { $self->changed( $fieldname ) } );
                
            }
            # ... and then warn() some info about what we're doing, and also append
            # the objects and signals to the *real* list
            foreach my $signal ( @signals ) {
                if ( $self->{debug} ) {
                    warn "Remembering object / signal pair for later disconnection ...\n"
                        . " Field:  $fieldname\n"
                        . " Widget: $widget\n"
                        . " Signal: $signal\n\n";
                }
                push @{$self->{objects_and_signals}},
                [
                    $widget,
                    $signal
                ];
            }
        }
    }
    
    if ( ! $self->{spinner} ) {
        if ( $self->{spinner_name} ) {
            $self->{spinner} = $self->get_widget( $self->{spinner_name} );
        }
    }
    
    if ( $self->{spinner} ) {
        
        $self->{record_spinner_value_changed_signal}
            = $self->{spinner}->signal_connect_after( 'value-changed' => sub {
                        $self->{spinner}->signal_handler_block( $self->{record_spinner_value_changed_signal} );
                        $self->move( undef, $self->{spinner}->get_text - 1 );
                        $self->{spinner}->signal_handler_unblock( $self->{record_spinner_value_changed_signal} );
                        return TRUE;
                    }
              );
        
        push @{$self->{objects_and_signals}},
        [
            $self->{spinner},
            $self->{record_spinner_value_changed_signal}
        ];
        
    }
    
    # Check recordset status when window is destroyed
    push @{$self->{objects_and_signals}},
    [
        $self->{window},
        $self->{window}->signal_connect( delete_event   => sub {
            if ( $self->{changed} ) {
                my $answer = TRUE;
                if ( ! $self->{auto_apply} ) {