summaryrefslogtreecommitdiffstats
path: root/lib/Net/Termcast.pm
blob: 307c2373783548921b7076c0bf7d8db0864c8ea4 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
package Net::Termcast;
use Moose;

use IO::Socket::Telnet;
use Term::VT102;

has host => (
    is      => 'ro',
    isa     => 'Str',
    default => 'termcast.org',
);

has port => (
    is      => 'ro',
    isa     => 'Int',
    default => 23,
);

has rows => (
    is      => 'ro', # should be rw at some point
    isa     => 'Int',
    default => 24,
);

has cols => (
    is      => 'ro', # should be rw at some point
    isa     => 'Int',
    default => 80,
);

has in_menu => (
    is       => 'rw',
    isa      => 'Bool',
    default  => 0,
    init_arg => undef,
);

has _vt => (
    is      => 'ro',
    isa     => 'Term::VT102',
    lazy    => 1,
    default => sub {
        my $self = shift;
        my $vt = Term::VT102->new(cols => $self->cols, rows => $self->rows);
        $vt->option_set(LINEWRAP => 1);
        $vt->option_set(LFTOCRLF => 1);
        return $vt;
    },
    init_arg => undef,
);

has _sock => (
    is       => 'ro',
    isa      => 'IO::Socket::Telnet'
    lazy     => 1,
    default  => sub {
        my $self = shift;
        my $socket = IO::Socket::Telnet->new(
            PeerAddr => $self->host,
            PeerPort => $self->port,
        );
        die "Unable to connect to " . $self->host . ": $!"
            if !defined($socket);
        return $socket;
    },
    init_arg => undef,
);

sub BUILD {
    my $self = shift;
    $self->_get_menu;
    $self->in_menu(1);
}

sub refresh {
    $self->sock->send(' ', 0);
    $self->_get_menu;
}

sub sessions {
}

sub select_session {
    my $self = shift;
    my ($session) = @_;
    return unless exists $self->sessions->{$session};
    $self->sock->send('q', 0) if $self->in_menu;
    $self->sock->send($session, 0);
    $self->_get_screen;
    $self->in_menu(0);
}

# XXX: these two should use color at some point
sub rows {
    my $self = shift;
    my @rows;
    push @rows, $self->row_plaintext($_) for 1..$self->rows;
    return @rows;
}

sub screen {
    my $self = shift;
    return join "\n", $self->rows;
}

sub _get_screen {
    my $self = shift;
    my $screen;
    $self->sock->recv($screen, 4096, 0);
    $self->vt->process($screen);
}

sub _get_menu {
    my $self = shift;
    return unless $self->in_menu;
    $self->_get_screen;
    $self->_parse_menu;
}

sub _parse_menu {
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;