view release on metacpan or  search on metacpan

lib/App/FQStat/Actions.pm  view on Meta::CPAN

package App::FQStat::Actions;
# App::FQStat is (c) 2007-2009 Steffen Mueller
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use strict;
use warnings;
use Time::HiRes qw/sleep time/;
use Term::ANSIScreen qw/RESET locate clline cls/;

use App::FQStat::Drawing qw/printline update_display/;
use App::FQStat::Input qw/poll_user get_input_key select_multiple_jobs select_job/;
use App::FQStat::Debug;
use App::FQStat::Config qw/get_config set_config/;
use App::FQStat::Colors qw/get_color/;


####################
# ACTIONS

# Scrolling: set display offset with boundary checking:
sub scroll_up {
  warnenter if ::DEBUG;
  my $lines = shift || 1;
  lock($::DisplayOffset);
  $::DisplayOffset -= $lines;
  $::DisplayOffset = 0 if $::DisplayOffset < 0;
}

sub scroll_down {
  warnenter if ::DEBUG;
  my $lines = shift || 1;
  lock($::DisplayOffset);
  $::DisplayOffset += $lines;
  my $limit = @{$::Records} - $::Termsize[1]+4;
  $::DisplayOffset = $limit if $::DisplayOffset > $limit;
  $::DisplayOffset = 0 if $::DisplayOffset < 0;
}


sub update_user_name {
  warnenter if ::DEBUG;
  my $input = poll_user("User name: ");
  lock($::User);
  if (not defined $input or $input =~ /^\s*$/) {
    $::User = undef;
  }
  else {
    $::User = $input;
  }
  update_display(1);
}

sub set_user_interval {
  warnenter if ::DEBUG;
  my $input = poll_user("Desired update interval: ");
  if (defined $input and  $input =~ /^\s*[+-]?(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee][+-]?\d+)?\s*$/) {
    $::UserInterval = $input+0;
    lock($::Interval);
    $::Interval = $::UserInterval;
  }
  update_display(1);
}

sub select_sort_field {
  warnenter if ::DEBUG;
  my @cols = ('status', @::Columns);

  # determine start sort field
  my $sort = 0;
  my $colno = 0;
  if (defined $::SortField) {
    foreach my $col (@cols) {
      if ($col eq $::SortField) {
        $sort = $colno;
        last;
      }
      $colno++;
    }
  }

  # key mappings
  my %ckeys = (
    'D' => sub { $sort--; $sort = @cols-1 if $sort < 0; }, # left
    'C' => sub { $sort++; $sort = 0 if $sort >= @cols;  }, # right
  );

  # print instructions
  locate(1,1);
  clline();
  print get_color("selected_cursor");
  print "Select Sort Field:";
  print RESET;
  print " (left/right to select, s/Enter to confirm, n for none, q to cancel)\n";

  while (1) {
    App::FQStat::Drawing::draw_header_line($sort+1);
    my $input = get_input_key();
    if (defined $input) {
      if ($input eq 's' or $input =~ /\n/ or $input =~ /\r/) { # select
        $::SortField = $cols[$sort];

lib/App/FQStat/Actions.pm  view on Meta::CPAN

        last if (defined $tmp and $tmp eq 'q');
      }
      print "\n";
    }
    sleep 2;
    update_display(1);
    return;
  } # end if $key is 'o' or 'O'
  else {
    die "Invalid key which stopped selection mode. (Sanity check)";
  }
  return 1;
}


sub clear_job_error_state {
  warnenter if ::DEBUG;
  # print instructions
  locate(1,1);
  clline();
  print get_color("user_instructions");
  print "Clear error state: Select with Space, span with 's', hit 'c' to apply or 'q' to cancel.";
  print RESET;
  print "\n";

  my ($selected, $key) = select_multiple_jobs( ['q', 'c'] );

  if ($key eq 'q' or @$selected == 0) {
    # cancel
    return 1; # redraw
  }
  elsif ($key eq 'c') {
    my $jobs = $::Records;
    my @ids = sort { $a <=> $b } map { $jobs->[$_][::F_id] } @$selected;
    cls();
    locate(3,1);
    print get_color("warning"), "Clearing the error state of the following jobs:", RESET();
    print "\n", join("\n", @ids);
    print "\n";

    foreach my $job (@ids) {
      if ( App::FQStat::System::run(get_config("qmodcmd"), '-cj', $job) ) {
        print "\n", get_color("warning"), "WARNING: Something went wrong. Return value: $!", RESET;
        print "\n(Hit 'q' to quit or any other key to continue)";
        my $tmp = get_input_key(1e9);
        last if (defined $tmp and $tmp eq 'q');
      }
      print "\n";
    }
    sleep 2;
    update_display(1);
    return;
  } # end if $key is 'c'
  else {
    die "Invalid key which stopped selection mode. (Sanity check)";
  }
  return 1;
}


sub update_highlighted_user_name {
  warnenter if ::DEBUG;
  my $input = poll_user("User name to highlight: ");
  if (not defined $input or $input =~ /^\s*$/) {
    $::HighlightUser = undef;
    update_display(1);
    return;
  }
  
  my $regex;
  eval { $regex = qr/$input/; };
  if ($@ or not defined $regex) {
    show_warning("Invalid regular expression!");
    update_display(1);
    return;
  }
  $::HighlightUser = $regex;
  update_display(1);
  return;
}


sub change_dependencies {
  warnenter if ::DEBUG;
  # print instructions
  locate(1,1);
  clline();
  print get_color("user_instructions");
  print "Change deps of jobs: Select with Space, span with 's', hit 'd' to confirm or 'q' to cancel.";
  print RESET;
  print "\n";

  my ($selected, $key) = select_multiple_jobs( ['q', 'd'] );

  if ($key eq 'q' or @$selected == 0) {
    # cancel
    return 1; # redraw
  }
  elsif ($key eq 'd') {
    locate(1,1);
    clline();
    print get_color("user_instructions");
    print "Jobs to depend on: Select with Space, span with 's', hit 'd' to confirm or 'q' to cancel.";
    print RESET;
    print "\n";

    my ($dependencies, $key) = select_multiple_jobs( ['q', 'd'] );
    if ($key eq 'q' or @$dependencies == 0) {
      # cancel
      return 1; # redraw
    }

    my $jobs = $::Records;
    my $deplist = join (',', map { $jobs->[$_][::F_id]  } @$dependencies);
    
    my @ids = sort { $a <=> $b } map { $jobs->[$_][::F_id] } @$selected;
    cls();
    locate(3,1);
    print get_color("warning"), "Changing the dependencies of the following jobs:", RESET();
    print "\n", join("\n", @ids);
    print "\n";