DBIx-Perform

 view release on metacpan or  search on metacpan

Perform/UserInterface.pm  view on Meta::CPAN

}

sub set_field {
    my $self  = shift;
    my $name  = shift;
    my $value = shift;
    my $app   = $self->{app_object};

    return $app->setfield( $name, $value );
}

sub change_field_focus_on_screen {
    my $self  = shift;
    my $fo    = shift;
    my $index = shift;    # can be empty

    warn "entering change_field_focus_on_screen" if $::TRACE;

    my ( $tag, $table, $col ) = $fo->get_names;

    my $l  = $self->get_field_list;
    my $fl = $l->clone_list;

    my $ct   = $self->get_current_table_name;
    my $form = $self->get_current_form;

    my $subform = $form->getSubform('DBForm');
    my $mode    = $subform->getField('editmode');

    my @taborder = $fl->get_field_tags($ct);

    $index = 0 if !defined($index);
    my $match = undef;

    $fl->reset;
    while ( my $fvar = $fl->iterate_list ) {
        my $tg = $fvar->get_names;
        if ( defined($match) ) {
            if ( $fvar->allows_focus($mode) ) {
                $subform->setField( 'FOCUSED', $taborder[$index] );
                $self->{focus} = $taborder[$index];
                return $index;
            }
        }
        $match = 1 if $tg eq $tag;
        return undef if $index++ > $#taborder;    # or not
    }

    warn "leaving change_field_focus_on_screen" if $::TRACE;
    return undef;                                 # no match or focus
}

sub register_button_handler {
    my $self    = shift;
    my $button  = shift;
    my $handler = shift;

    my $bhandler = $self->{button_handlers}->{$button} = $handler;
}

sub update_text {
    my $form = shift;
    my $GlobalUi    = $DBIx::Perform::GlobalUi;
    my $wid         = $form->getWidget('ModeButtons');
    my $val         = $wid->getField('VALUE');
    my $names       = $wid->getField('NAMES');
#    my $labels      = $wid->getField('LABELS');
    my $thisname    = lc( $$names[$val] );
#    my $thislabel   = lc( $$labels[$val] );
    my $btn_handler = $Button_handlers{$thisname};

    $GlobalUi->display_comment("");
    $GlobalUi->clear_display_error;
    my $m   = $Info_messages{$thisname};
    my $wmm = $form->getWidget('InfoMsg');
    $wmm->setField( 'VALUE', $m );
    $wmm->setField( 'COLUMNS', length $m );
    return $btn_handler;
}

sub button_push {
    my $form = shift;
    my $key  = shift;

    my $GlobalUi    = $DBIx::Perform::GlobalUi;
    my $app         = $Global_app_ref;                   # sorry

    warn "TRACE: entering button_push\n" if $::TRACE;
    if ( $key eq KEY_RIGHT || $key eq KEY_LEFT || $key eq ' '
         || $key eq KEY_UP || $key eq KEY_DOWN ) {
        $form->setField( 'DONTSWITCH', 1 );
        update_text($form);
	return;
    }
    elsif ( $key =~ /\d/ ) {
        warn "TRACE: button_push, number key\n" if $::TRACE;
        $app->{'number'} *= 10;
        $app->{'number'} += $key;
        $form->setField( 'DONTSWITCH', 1 );
	return;
    }
    elsif ( $key eq "\cw" ) {
        $GlobalUi->display_help_screen(0);
        $form->setField( 'DONTSWITCH', 1 );
	return;
    }
    my $btn_handler = update_text($form);
    if ( $btn_handler && ref($btn_handler) eq 'CODE' ) {
        &$btn_handler( lc($key), $form );
        $app->{'number'} = 0;
    }
    warn "TRACE: leaving button_push\n" if $::TRACE;
}

# replace the buttons with a mode label
sub change_buttons_to_label {
    my $self = shift;
    my $str  = shift;

    warn "entering change_buttons_to_label\n" if $::TRACE;

Perform/UserInterface.pm  view on Meta::CPAN

    $wid->setField( 'COLUMNS', length $str );

    warn "leaving change_buttons_to_label\n" if $::TRACE;
    return undef;
}

# replace a mode label with mode buttons
sub change_label_to_buttons {
    my $self = shift;

    warn "entering change_label_to_buttons\n" if $::TRACE;

    my $form = $self->{form_object};
    my $wid  = $form->getWidget('ModeLabel');

    $wid->setField( 'VALUE',   '' );
    $wid->setField( 'COLUMNS', 0 );

    $self->change_modename($msgs->[2]); #msgs->[2]='perform' if LANG=en 
    warn "leaving change_label_to_buttons\n" if $::TRACE;
    return undef;
}

sub switch_buttons {
    my $self = shift;
    my $form = shift;

    warn "entering switch_buttons\n" if $::TRACE;

    my $wid    = $form->getWidget('ModeButtons');

    $wid->setField( 'NAMES', \@Button_yn_names );
    $wid->setField( 'LABELS', \@Buttons_yn );
    $self->change_modename( $msgs->[9] );  # 9 = 'remove'

    $wid  = $form->getWidget('InfoMsg');
    $wid->setField( 'VALUE', $msgs->[37] );  
    warn "leaving switch_buttons\n" if $::TRACE;
}

sub change_modename {
    my $self = shift;
    my $name = shift;

    warn "entering change_modename\n" if $::TRACE;

    my $form = $self->{form_object};

    $name = $name . ':  ';
    $name = uc($name);

    my $wid = $form->getWidget('ModeName');
    $wid->setField( 'VALUE', $name );
    $wid = $form->getWidget('ModeLabel');
    $wid->setField( 'X', length $name );

    warn "leaving change_modename\n" if $::TRACE;
    return undef;
}

sub update_info_message {
    return;
    my $self    = shift;
    my $form    = shift;
    my $message = shift;

    warn "entering update_info_message\n" if $::TRACE;

    my %info_msgs = %{ $self->{info_messages} };
    my $msg       = $info_msgs{$message};
    my $wid       = $form->getWidget('InfoMsg');

    $wid->setField( 'VALUE', $msg );

    warn "leaving update_info_message\n" if $::TRACE;
    return undef;
}

sub update_subform {
    my $self    = shift;
    my $subform = shift;

    my $mwh = $subform->{MWH};
    $subform->draw($mwh);

    return undef;
}

# setup bracket values for a tag widget
sub set_field_display_bounds {
    my $self  = shift;
    my $tag   = shift;
    my $lchar = shift;
    my $rchar = shift;

#warn "TRACE: entering set_field_display_bounds for $lchar $tag $rchar\n"
#  if $::TRACE;

    my $form    = $self->get_current_form;
    my $subform = $form->getSubform('DBForm');

    my $ostr = $tag . ".openbracket";
    my $cstr = $tag . ".closebracket";

    my $ow = $subform->getWidget($ostr);
    my $cw = $subform->getWidget($cstr);

    return if !defined($ow) || !defined($cw);

    $ow->setField( 'VALUE', $lchar );
    $cw->setField( 'VALUE', $rchar );

    #    warn "TRACE: leaving set_field_display_bounds\n" if $::TRACE;
    return undef;
}

sub set_field_bounds_on_screen {
    my $self = shift;

    warn "TRACE: entering set_field_bounds_on_screen\n" if $::TRACE;

    my $current_table = $self->get_current_table_name;

    my $app     = $self->{app_object};
    my $form    = $self->get_current_form;
    my $subform = $form->getSubform('DBForm');
    my $mode    = $subform->getField('editmode');

    my $pl = $self->get_field_list;
    my $fl = $pl->clone_list;

    $fl->reset;
    while ( my $f = $fl->iterate_list ) {
        my ( $tag, $table, $column ) = $f->get_names;
        $self->set_field_display_bounds( $tag, ' ', ' ' );
    }

    $fl->reset;
    while ( my $f = $fl->iterate_list ) {

Perform/UserInterface.pm  view on Meta::CPAN

          if $tab eq $table;    # return on a match
                                # otherwise increment the global ds
        $self->increment_global_tablelist;
        $self->increment_global_rowlist;
    }
    return undef;
}

# tables are ordered by their appearance in the attribute section
# in the ".per" file

sub get_number_of_tables {
    my $self = shift;
    my $form = shift;

    my @tables = @{ $self->{attribute_table_names} };
    return $#tables;
}

sub get_primary_table_name {
    my $self = shift;
    my $form = shift;

    my @tnames = @{ $self->{attribute_table_names} };

    return $tnames[0];
}

sub get_current_table_name {
    my $self = shift;
    my $form = shift;

    my @tnames = @{ $self->{attribute_table_names} };
    my $tnum   = $self->{current_table_number};

    return $tnames[$tnum];
}

sub get_table_number {
    my $self = shift;
    my $form = shift;

    return $self->{current_table_number};
}

sub increment_global_tablelist {
    my $self = shift;

    my $form = $self->get_current_form;

    my $num = $self->get_table_number;
    my $max = $self->get_number_of_tables;

    ++$num;
    $num = 0 if $num > $max;

    # updates class and display
    $self->update_table($num);
}

sub update_table {
    my $self = shift;
    my $num  = shift;

    $self->update_table_number($num);
    $self->update_table_name($num);
}

# these two subs update the form

sub update_table_number {
    my $self         = shift;
    my $table_number = shift;

    my $form = $self->get_current_form;

    $self->{current_table_number} = $table_number;

    $table_number++;
    my $str = '** ' . $table_number . ': ';

    my $wid = $form->getWidget('TableNumber');
    $wid->setField( 'VALUE', $str );
}

sub update_table_name {
    my $self         = shift;
    my $table_number = shift;

    my $form   = $self->get_current_form;
    my @tnames = @{ $self->{attribute_table_names} };
    my $name   = $tnames[$table_number];

    $name = $name . ' table**';

    $self->{current_table_name} = $name;

    #  I don't know???
    #$self->set_field_bounds_on_screen;

    my $wid = $form->getWidget('TableName');
    $wid->setField( 'VALUE', $name );
}

sub get_current_form {
    my $self = shift;

    my $app = $self->{app_object};
    my $fn  = $app->getField('form_name');

    return $app->getForm($fn);
}

# screen support

# This assumes that any duplicate field tags
# are defined to always have the same value
# returns the value of the first instance of
# the field_tag parameter found in the global field_list.

sub get_screen_value {
    my $self      = shift;
    my $field_tag = shift;

    my $app = $self->{app_object};
    my $formn = $app->getField('form_names');

    my $i = 0;
    for (my $i = 0; $i < @$formn; $i++) {
        my $form = $app->getForm( 'Run' . $i );
        last if !defined($form);

        my $subform = $form->getSubform('DBForm');
#        my $subform = $self->{subforms}->[$i];
#        last if !defined $subform;
        my $w       = $subform->getWidget($field_tag);

        return $w->getField('VALUE')
          if defined($w);
    }
    return undef;
}

sub get_screen_subform_widget {
    my $self      = shift;
    my $field_tag = shift;