view release on metacpan or  search on metacpan

lib/App/Cme/Common.pm  view on Meta::CPAN

}

sub init_cme {
    my ($self, @args) = @_;
    # model and inst are deleted if not kept in a scope
    return ( $self->model(@args) , $self->instance(@args), $self->instance->config_root );
}

sub save {
    my ($self,$inst,$opt) = @_;

    $inst->say_changes unless $opt->{quiet};

    # if load was forced, must write back to clean up errors (even if they are not changes
    # at semantic level, i.e. removed unnecessary stuff)
    $inst->write_back( force => $opt->{force_load} || $opt->{save} );

    return;
}

sub run_tk_ui {
    my ($self, $instance, $opt) = @_;

    require Config::Model::TkUI;
    require Tk;
    require Tk::ErrorDialog;
    Tk->import;

    no warnings 'once'; ## no critic (TestingAndDebugging::ProhibitNoWarnings)
    my $mw = MainWindow->new;
    $mw->withdraw;

    # Thanks to Jerome Quelin for the tip
    $mw->optionAdd( '*BorderWidth' => 1 );

    # -root parameter is deprecated
    my $cmu = $mw->ConfigModelUI( -instance => $instance );

    $instance->on_message_cb(sub{$cmu->show_message(@_);});

    if ($opt->{open_item}) {
        my $obj = $instance->grab(step => $opt->{open_item}, autoadd => 0);
        # using afterIdle avoids geometry problem where the right side
        # of the widget is not visible
        $mw->afterIdle( sub {
            $cmu->force_element_display($obj);
            my $path = $cmu->{tktree}->selectionGet;
            $cmu->create_element_widget('edit', $path);
        })
    }

    &MainLoop;    # Tk's

    return;
}

sub run_shell_ui ($self, $term_class, $inst) {
    my $shell_ui = $term_class->new (
        root   => $inst->config_root,
        title  => $inst->application . ' configuration',
        prompt => ' >',
    );

    # engage in user interaction
    $shell_ui->run_loop;

    return;
}

sub get_documentation {
    my ($self) = @_;

    my $parser = Pod::POM->new();
    my $pkg = blessed ($self);
    $pkg =~ s!::!/!g;
    my $pom = $parser->parse_file($INC{$pkg.'.pm'})
        || croak $parser->error();

    my $sections = $pom->head1();
    my @ret ;
    foreach my $s (@$sections) {
        push (@ret ,$s) if $s->title() =~ /DESCRIPTION|USAGE|OPTIONS|EXIT/;
    }
    return join ("", map { Pod::POM::View::Text->print($_)} @ret) . "Options:\n";;
}

sub commit ($self, $msg) {
    system(qw/git commit -a -m/, $msg) == 0
        or die "git commit failed: $?\n";

    return;
}

sub autostash ($self) {
    ## no critic(InputOutput::ProhibitBacktickOperators)
    my $r = `git status --porcelain --untracked-files=no`;
    if ($?) {
        die "git status command failed: $?\n";
    }
    if ($r) {
        system(qw/git stash push --quiet --message/, "cme run auto stash") == 0
            or die "git stash push failed: $?\n";
        return 1;
    }
    return 0;
}

sub pop_stash ($self) {
    system(qw/git stash pop --quiet/) == 0
        or die "git stash pop failed: $?\n";
    return;
}

1;

__END__

=pod

=encoding UTF-8