Config-Model-CursesUI

 view release on metacpan or  search on metacpan

lib/Config/Model/CursesUI.pm  view on Meta::CPAN

        my $value = $leaf_object->fetch(check => 'no') ;
        my $value_str = length($value)          ? $value 
            : $leaf_object->mandatory ? '*MISSING*' 
            :                            undef ;
        $value_str = '"'.$value_str.'"' if defined $value_str && $value_str =~ /\s/ ;
        push @$data_ref, [ $node, $element_name, $index , $value_str ] ;
    } ;

    my $hash_cb = sub {
        my ($scanner, $data_ref,$node,$element_name,@keys) = @_ ;

        foreach my $k (@keys) {
            push @$data_ref, [ $node, $element_name, undef, $k ] ;
            $scanner->scan_hash($data_ref,$node,$element_name,$k) ;
        }
    } ;

    my $node_cb = sub {
        my ($scanner, $data_ref,$node,$element_name,$key, $contained_node) = @_ ;
        push @$data_ref, [ $node, $element_name, $key ] ;
        $scanner->scan_node($data_ref,$contained_node);
    } ;

    my $leaf_cb = ($select eq 'audit') ? $audit_cb : $std_cb ;

    my @scan_args = (
                      fallback         => 'all',
                      hash_element_cb  => $hash_cb ,
                      leaf_cb          => $leaf_cb ,
                      node_element_cb  => $node_cb ,
                      check            => 'no',
                  );

    my $view_scanner = Config::Model::ObjTreeScanner->new (@scan_args);

    my @leaves ;
    eval {
        # perform the scan that fills @leaves
        $view_scanner-> scan_node(\@leaves, $root) ;
    } ;

    if ($@) {
        warn "$@" ;
        $self->{cui}->fatalerror("display_view_list: $@") ;
    }
    ;

    my $idx = 0;
    my @good_leaves = $view_type eq 'tree' ? @leaves : grep { @$_ == 4 } @leaves ;

    my %labels = map { 
        my ($node,$element,$index,$value) = @$_ ;
        my $name  = defined $index ? "$element:$index" : $element ;
        my $loc = $node->location ;
        no warnings "uninitialized" ;
        my $str ;
        if ($view_type eq 'tabular') {
            $str =sprintf("%-28s | %-10s | %-30s", $name,$value,$node->name) ;
        }
        else {
            my @level = split m/ +/ ,$loc ;
            $str = ('. ' x scalar @level) . $name ;
            $str .= " = '$value'" if @$_ == 4;
        }
        ($idx++,$str) ;
    } @good_leaves ;

    my $win = $self->set_center_window("View ".$root->name);

    $win -> add ( undef, 'Label',
                  -text => "Select the item you're looking for. \n"
                  . "Press </> for a "
                  . "'less'-like search through the list."
              ) ;

    my $listbox ;
    my $sub = sub {
        my ($searched) = $listbox->get;
        my ($node,$element,$index,$value) = @{$good_leaves[$searched]} ;

        # replace call with a call with a selected value
        pop @{$self->{stack}} ; 
        push @{$self->{stack}} , 
            sub{$self->display_view_list($root,$select,$view_type,$searched)};

        if (defined $index) {
            $self->scan('hash',$node,$element,$index) ;
        } 
        else {
            $self->scan('element',$node,$element) ;
        }
    } ;

    $listbox = $win -> add ( undef, 'Listbox',
                             '-y'        => 3,
                             -values     => [0 .. $#good_leaves],
                             -labels     => \%labels ,
                             -border     => 1,
                             -title      => 'Search element',
                             -vscrollbar => 1,
                             -onchange   => $sub ,
                             -selected   => $pre_select 
                         ) ;

    $listbox->focus ;

    #$self->add_std_button($win,$node,$but) ;
    push @{$self->{stack}} , 
        sub{$self->display_view_list($root,$select,$view_type,$pre_select)};

}


##### wizard: explore depth first and stop on "important" or undefined
##### mandatory elements (or on erroneous elements ?)
sub wizard {
    my ($self,$root, $stop_on_important) = @_;

    # reset location label
    $self->{loc_label}->text('') ;



( run in 0.465 second using v1.01-cache-2.11-cpan-71847e10f99 )