view release on metacpan or  search on metacpan

lib/App/Yath/Command/server.pm  view on Meta::CPAN

        local_file  => $file =~ m{^/} ? $file : "./demo/$file",
    });

    state $user = $config->schema->resultset('User')->find_or_create({username => 'root', password => 'root', realname => 'root'});

    my $run = $config->schema->resultset('Run')->create({
        run_uuid   => format_uuid_for_db(gen_uuid()),
        user_id    => $user->user_id,
        mode       => $mode,
        status     => 'pending',
        canon      => 1,
        project_id => $projects{$project}->project_id,

        log_file_id => $logfile->log_file_id,
    });

    return $run;
}

sub shell {
    my $self = shift;
    my ($pid) = @_;

    # Return that we should exit if the PID is wrong.
    return 1 unless $pid == $$;

    my $settings = $self->settings;
    my $server = $self->{+SERVER};
    my $config = $self->{+CONFIG};

    $SIG{TERM} = sub { $SIG{TERM} = 'DEFAULT'; die "Cought SIGTERM exiting...\n" };
    $SIG{INT}  = sub { $SIG{INT}  = 'DEFAULT'; die "Cought SIGINT exiting...\n" };

    STDERR->autoflush();

    my $dsn = $config->dbi_dsn;

    print "DBI_DSN: $dsn\n\n";
    print "\n";
    print "| Yath Server Developer Shell       |\n";
    print "| type 'help', 'h', or '?' for help |\n";

    use Term::ReadLine;
    my $term   = Term::ReadLine->new('Yath dev console');
    my $OUT    = $term->OUT || \*STDOUT;

    my $cmds = $self->command_list();
    $term->Attribs->{'attempted_completion_function'} = sub {
        my ($text, $start, $end) = @_;

        if ($start !~ m/\s/) {
            my @found;
            for my $set (@$cmds) {
                next unless $set->[0] =~ m/^\Q$text\E/;
                push @found => $set->[0];
            }

            return @found;
        }

        my ($fname) = reverse(split m/\s+/, $text);

        return Term::ReadLine::Gnu->filename_completion_function($fname // '', 0);
    };

    my $prompt = "\n> ";
    while (1) {
        my $in = $term->readline($prompt);

        return 1 if !defined($in);
        chomp($in);
        next unless length($in);

        return 1 if $in =~ m/^(q|x|exit|quit)$/;

        $term->addhistory($in);

        if ($in =~ m/^(help|h|\?)(?:\s(.+))?$/) {
            $self->shell_help($1);
            next;
        }

        my ($cmd, $args) = split /\s/, $in, 2;

        my $meth = "shell_$cmd";
        if ($self->can($meth)) {
            eval { $self->$meth($args); 1 } or warn $@;
        }
        else {
            print STDERR "Invalid command '$in'\n";
        }
    }
}

sub shell_help_text { "Show command list." }
sub shell_help {
    my $self = shift;
    my $class = ref($self);

    print "\nAvailable commands:\n";
    printf(" %-12s   %s\n", "[q]uit", "Quit the program.");
    printf(" %-12s   %s\n", "e[x]it", "Exit the program.");
    printf(" %-12s   %s\n", "[h]elp", "Show this help.");
    printf(" %-12s   %s\n", "?", "Show this help.");

    my $cmds = $self->command_list();
    for my $set (@$cmds) {
        my ($cmd, $text) = @$set;
        next if $cmd eq 'help';
        printf(" %-12s   %s\n", $cmd, $text);
    }

    print "\n";
}

sub command_list {
    my $self = shift;
    my $class = ref($self) || $self;

    my @out;