BBS-Universal
view release on metacpan or search on metacpan
);
use DBI;
use DBD::mysql;
use Cwd;
use DateTime;
use Time::HiRes qw(time sleep);
use Debug::Easy;
use Getopt::Long;
use Term::ReadKey;
use Term::ANSIScreen qw( :cursor :screen );
use Term::ANSIColor;
use Text::SimpleTable;
use List::Util qw(min max);
use Text::Format;
use IO::Socket qw(AF_INET SOCK_STREAM SHUT_WR SHUT_RDWR SHUT_RD);
# use Cache::Memcached;
use Cache::Memcached::Fast;
use BBS::Universal;
=over 4
=item B<ASCII>
Simple plain ASCII text
=item B<ATASCII>
Atari 8 bit ATASCII
It has graphics characters and cursor movement
=item B<PETSCII>
Commodore 8 bit PETSCII
It has color, graphics characters and cursor movement
=item B<ANSI>
ANSI encoded text
It has color, graphics characters and cursor movement. Typically used on Terminals and Unix/Linux/Windows/Mac consoles and terminal clients.
=back
=head1 COPYRIGHT
Copyright 2023-2026 Richard Kelsch
All Rights Reserved
=head1 LICENSE
files/sysop/manual-introduction.ANSI view on Meta::CPAN
[% JUSTIFIED %]Now I reflected on the past and got interested in retro-computers. I noticed they were becoming popular again. Some people ran
serial to TCP/IP adapters and running old BBS programs on them. Quite ingenious. PCs have ANSI BBS programs, one being [% ITALIC %]SBBS[% RESET %].[% ENDJUSTIFIED %]
[% JUSTIFIED %]I decided to make this program, [% ITALIC %]BBS::Universal[% RESET %] to accommodate plain ASCII, ANSI, ATASCII, and PETSCII formats.
Instead of a redirected modem program like many of the others, this one is written to be a network server.[% ENDJUSTIFIED %]
[% BOLD %][% B_YELLOW %][% BLACK %] COMMANDS VERSUS TOKENS [% RESET %][% YELLOW %]ðŸ¬[% RESET %]
The system bifercates the SysOp system from the user system. This means SysOp tokens and commands will not work when a user is using the system.
Commands are typically used in menus as a choice. Tokens are macros that are embedded in text. They can be colors, cursor controls, BBS system data.
lib/BBS/Universal.pm view on Meta::CPAN
'exit' => 'threads_only',
'stringify',
);
use Debug::Easy;
use DateTime;
use DBI;
use DBD::mysql;
use File::Basename;
use Time::HiRes qw(time sleep);
use Term::ReadKey;
use Term::ANSIScreen qw( :cursor :screen );
use Term::ANSIColor;
use Text::Format;
use Text::SimpleTable;
use List::Util qw(min max);
use IO::Socket qw(AF_INET SOCK_STREAM SHUT_WR SHUT_RDWR SHUT_RD);
use Cache::Memcached::Fast;
use Number::Format 'format_number';
use XML::RSS::LibXML;
use File::Path;
use File::Which;
lib/BBS/Universal.pm view on Meta::CPAN
$self->parse_telnet_escape(ord($command), ord($option));
$escape = TRUE;
} ## end if ($key eq chr(255))
} until (!$escape || $self->is_connected());
ReadMode 'restore', $self->{'cl_socket'};
threads->yield;
} ## end elsif ($self->is_connected...)
return ($key) if ($key eq chr(13));
if ($key eq chr(127) or $key eq chr(7)) {
if ($mode eq 'ANSI') {
$key = $self->{'ansi_meta'}->{'cursor'}->{'BACKSPACE'}->{'out'};
} elsif ($mode eq 'ATASCII') {
$key = $self->{'atascii_meta'}->{'BACKSPACE'}->{'out'};
} elsif ($mode eq 'PETSCII') {
$key = $self->{'petscii_meta'}->{'BACKSPACE'}->{'out'};
} else {
$key = $self->{'ascii_meta'}->{'BACKSPACE'}->{'out'};
}
$self->output("$key $key") if ($echo);
} ## end if ($key eq chr(127) or...)
threads->yield;
lib/BBS/Universal.pm view on Meta::CPAN
$self->{'debug'}->DEBUG(['Start Get Line']);
$self->flush_input();
my $key;
$self->output($line) if ($line ne '');
my $mode = $self->{'USER'}->{'text_mode'};
my $backspace;
if ($mode eq 'ANSI') {
$backspace = $self->{'ansi_meta'}->{'cursor'}->{'BACKSPACE'}->{'out'};
} elsif ($mode eq 'ATASCII') {
$backspace = $self->{'atascii_meta'}->{'BACKSPACE'}->{'out'};
} elsif ($mode eq 'PETSCII') {
$backspace = $self->{'petscii_meta'}->{'BACKSPACE'}->{'out'};
} else {
$backspace = $self->{'ascii_meta'}->{'BACKSPACE'}->{'out'};
}
if ($echo == PASSWORD) {
$self->{'debug'}->DEBUG([' Mode: PASSWORD']);
lib/BBS/Universal.pm view on Meta::CPAN
#
# Flatten the ansi_meta lookup to a simple, case-insensitive hash for a single-pass
# substitution of tokens like [% RED %], [% RESET %], etc.
#
if ($text =~ /CLS/i && $self->{'local_mode'}) {
my $ch = locate(($self->{'CACHE'}->get('START_ROW') + $self->{'CACHE'}->get('ROW_ADJUST')), 1) . cldown;
$text =~ s/\[\%\s+CLS\s+\%\]/$ch/gsi;
}
my %lookup;
for my $code (qw(foreground background special clear cursor attributes)) {
my $map = $self->{'ansi_meta'}->{$code} or next;
while (my ($name, $info) = each %{$map}) {
next unless (defined($info->{out}));
$lookup{ lc $name } = $info->{out};
}
} ## end for my $code (qw(foreground background special clear cursor attributes))
# Final single-pass replacement for remaining [% ... %] tokens.
# If token matches a lookup entry, substitute; otherwise if it's a named char use charnames;
# else leave token visible.
###
$text =~ s/\[\%\s*(.+?)\s*\%\]/
do {
my $tok = $1;
my $key = lc $tok;
if ( exists $lookup{$key} ) {
lib/BBS/Universal.pm view on Meta::CPAN
sub ansi_output {
my $self = shift;
my $text = shift;
$self->{'debug'}->DEBUG(['Start ANSI Output']);
my $mlines = (exists($self->{'USER'}->{'max_rows'})) ? $self->{'USER'}->{'max_rows'} - 3 : 21;
my $lines = $mlines;
$text = $self->ansi_decode($text);
my $s_len = length($text);
my $nl = $self->{'ansi_meta'}->{'cursor'}->{'NEWLINE'}->{'out'};
foreach my $count (0 .. $s_len) {
my $char = substr($text, $count, 1);
if ($char eq "\n") {
if ($text !~ /$nl/ && !$self->{'local_mode'}) { # translate only if the file doesn't have ASCII newlines
$char = $nl;
}
$lines--;
if ($lines <= 0) {
$lines = $mlines;
lib/BBS/Universal.pm view on Meta::CPAN
['SS3', "\eO", 'Single Shift 3'],
['CSI', "\e[", 'Control Sequence Introducer'],
['OSC', "\e]", 'Operating System Command'],
['SOS', "\eX", 'Start Of String'],
['ST', "\e\\", 'String Terminator'],
['DCS', "\eP", 'Device Control String'],
);
# Clear controls
my $clear = $pairs_to_map->(
['CLS', "\e[2J\e[H", 'Clear screen and place cursor at the top of the screen'],
['CLEAR', "\e[2J", 'Clear screen and keep cursor location'],
['CLEAR LINE', "\e[0K", 'Clear the current line from cursor'],
['CLEAR DOWN', "\e[0J", 'Clear from cursor position to bottom of the screen'],
['CLEAR UP', "\e[1J", 'Clear to the top of the screen from cursor position'],
);
# Cursor movement and control
my $cursor = $pairs_to_map->(
['BACKSPACE', chr(8), 'Backspace'],
['RETURN', chr(13), 'Carriage Return (ASCII 13)'],
['LINEFEED', chr(10), 'Line feed (ASCII 10)'],
['NEWLINE', chr(13) . chr(10), 'New line (ASCII 13 and ASCII 10)'],
['HOME', "\e[H", 'Place cursor at top left of the screen'],
['UP', "\e[A", 'Move cursor up one line'],
['DOWN', "\e[B", 'Move cursor down one line'],
['RIGHT', "\e[C", 'Move cursor right one space non-destructively'],
['LEFT', "\e[D", 'Move cursor left one space non-destructively'],
['NEXT LINE', "\e[E", 'Place the cursor at the beginning of the next line'],
['PREVIOUS LINE', "\e[F", 'Place the cursor at the beginning of the previous line'],
['SAVE', "\e[s", 'Save cureent cursor position'],
['RESTORE', "\e[u", 'Restore the cursor to the saved position'],
['CURSOR ON', "\e[?25h", 'Turn the cursor on'],
['CURSOR OFF', "\e[?25l", 'Turn the cursor off'],
['SCREEN 1', "\e[?1049l", 'Set display to screen 1'],
['SCREEN 2', "\e[?1049h", 'Set display to screen 2'],
);
# Text attributes
my $attributes = $pairs_to_map->(
['FONT 1', "\e[1m", 'ANSI FONT 1'],
['FONT 2', "\e[2m", 'ANSI FONT 2'],
['FONT 3', "\e[3m", 'ANSI FONT 3'],
['FONT 4', "\e[4m", 'ANSI FONT 4'],
lib/BBS/Universal.pm view on Meta::CPAN
} @fg_extra;
my $background = $pairs_to_map->(
map { [ $_->[0], $_->[1], $_->[2] ] } @bg16,
map { [ $_->[0], $_->[1], $_->[2] ] } @bg_extra,
);
$self->{'ansi_meta'} = {
special => $special,
clear => $clear,
cursor => $cursor,
attributes => $attributes,
foreground => $foreground,
background => $background,
};
$self->{'debug'}->DEBUG(['End ANSI Initialize']);
return($self);
} ## end sub ansi_initialize
lib/BBS/Universal.pm view on Meta::CPAN
my @names = (sort(keys %{ $self->{'ansi_meta'}->{'clear'} }));
while (scalar(@names)) {
my $name = shift(@names);
$text .= '[% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-63s', $name) . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', $self->ansi_description('clear', $name)) . ' [% BRIGHT GREEN %]│[% RESET %]' . "\n";
}
}
# CURSOR section
$text .= '[% BRIGHT GREEN %]â•žâ•â• [% BOLD %][% BRIGHT YELLOW %]CURSOR [% RESET %][% BRIGHT GREEN %]' . 'â•' x 55 . '╪' . 'â•' x 56 . 'â•¡[% RESET %]' . "\n";
{
my @names = (sort(keys %{ $self->{'ansi_meta'}->{'cursor'} }));
while (scalar(@names)) {
my $name = shift(@names);
$text .= "$bar " . sprintf('%-63s', $name) . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', $self->ansi_description('cursor', $name)) . " $bar\n";
}
$text .= "$bar " . sprintf('%-63s', 'LOCATE column,row') . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', 'Sets the cursor location') . " $bar\n";
$text .= "$bar " . sprintf('%-63s', 'SCROLL UP count') . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', 'Scrolls the screen up by "count" lines') . " $bar\n";
$text .= "$bar " . sprintf('%-63s', 'SCROLL DOWN count') . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', 'Scrolls the screen down by "count" lines') . " $bar\n";
}
# ATTRIBUTES section
$text .= '[% BRIGHT GREEN %]â•žâ•â• [% BOLD %][% BRIGHT YELLOW %]ATTRIBUTES [% RESET %][% BRIGHT GREEN %]' . 'â•' x 51 . '╪' . 'â•' x 56 . 'â•¡[% RESET %]' . "\n";
{
my @names = grep(!/FONT \d/, (sort(keys %{ $self->{'ansi_meta'}->{'attributes'} })));
foreach my $name (@names) {
if ($name =~ /FONT|HIDE|RING BELL/) {
lib/BBS/Universal.pm view on Meta::CPAN
} ## end sub sysop_hostname
sub sysop_locate_middle {
my $self = shift;
my $color = (scalar(@_)) ? shift : 'B_WHITE';
my ($wsize, $hsize, $wpixels, $hpixels) = GetTerminalSize();
my $middle = int($wsize / 2);
my $string;
if ($color =~ /^B_/) {
$string = "\r" . $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x $middle . $self->{'ansi_meta'}->{'background'}->{$color}->{'out'} . ' ' . $self->{'ansi_meta'}->{'attributes'}->{'RESET'}->{'out'};
} else {
$string = "\r" . $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x $middle . $self->{'ansi_meta'}->{'foreground'}->{$color}->{'out'} . ' ' . $self->{'ansi_meta'}->{'attributes'}->{'RESET'}->{'out'};
}
return ($string);
} ## end sub sysop_locate_middle
sub sysop_memory {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Memory']);
my $memory = `nice free`;
my @mem = split(/\n$/, $memory);
lib/BBS/Universal.pm view on Meta::CPAN
$table = Text::SimpleTable->new(11, 80);
$table->row('TITLE', "\n" . charnames::string_vianame('OVERLINE') x 80);
$table->row('DESCRIPTION', "\n" . charnames::string_vianame('OVERLINE') x 80);
my $text = $table->twin('MAGENTA')->draw();
while ($text =~ / (TITLE|DESCRIPTION) /) {
my $ch = $1;
my $new = '[% BRIGHT YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$self->sysop_output("\n$text");
print $self->{'ansi_meta'}->{'cursor'}->{'UP'}->{'out'} x 5, $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 16;
my $title = $self->sysop_get_line(ECHO, 80, '');
if ($title ne '') {
print "\r", $self->{'ansi_meta'}->{'cursor'}->{'DOWN'}->{'out'}, $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 16;
my $description = $self->sysop_get_line(ECHO, 80, '');
if ($description ne '') {
$sth = $self->{'dbh'}->prepare('INSERT INTO file_categories (title,description) VALUES (?,?)');
$sth->execute($title, $description);
$sth->finish();
print "\n\nNew Entry Added\n";
} else {
print "\n\nNevermind\n";
}
} else {
lib/BBS/Universal.pm view on Meta::CPAN
my $mode = $self->{'USER'}->{'text_mode'};
my $timeout = $self->{'USER'}->{'timeout'} * 60;
local $/ = "\x{00}";
ReadMode 'ultra-raw';
$key = ($blocking) ? ReadKey($timeout) : ReadKey(-1);
ReadMode 'restore';
threads->yield;
return ($key) if ($key eq chr(13));
if ($key eq chr(127)) {
$key = $self->{'ansi_meta'}->{'cursor'}->{'BACKSPACE'}->{'out'};
}
if ($echo == NUMERIC && defined($key)) {
unless ($key =~ /[0-9]/) {
$key = '';
}
}
threads->yield;
return ($key);
} ## end sub sysop_get_key
lib/BBS/Universal.pm view on Meta::CPAN
} else {
if ($echo == STRING || $echo == ECHO || $echo == NUMERIC || $echo == HOST) {
$limit = shift;
}
$line = shift;
} ## end else [ if (ref($type) eq 'HASH')]
chomp($line);
$self->{'debug'}->DEBUGMAX([$type, $echo, $line]);
print $line if ($line ne '');
my $mode = 'ANSI';
my $bs = $self->{'ansi_meta'}->{'cursor'}->{'BACKSPACE'}->{'out'};
if ($echo == RADIO) {
$self->{'debug'}->DEBUG([' SysOp Get Line RADIO']);
my $mapping;
my @menu_choices = @{$self->{'MENU CHOICES'}};
foreach my $choice (@{$choices}) {
$mapping->{ shift(@menu_choices) } = {
'command' => $choice,
'color' => 'WHITE',
lib/BBS/Universal.pm view on Meta::CPAN
$line = '';
} else {
$line = $mapping->{$key}->{'command'};
}
} elsif ($echo == BOOLEAN) {
$self->{'debug'}->DEBUG([' SysOp Get Line BOOLEAN']);
do {
$key = $self->sysop_get_key(SILENT, BLOCKING);
if (uc($key) eq 'T') {
$line = 'ON';
print $self->{'ansi_meta'}->{'cursor'}->{'LEFT'}->{'out'} x 5, 'ON', clline;
} elsif (uc($key) eq 'F') {
$line = 'OFF';
print $self->{'ansi_meta'}->{'cursor'}->{'LEFT'}->{'out'} x 4, 'OFF', clline;
} elsif ($key ne chr(13) && $key ne chr(3)) {
print chr(7);
}
} until ($key eq chr(13) or $key eq chr(3));
} elsif ($echo == NUMERIC) {
$self->{'debug'}->DEBUG([' SysOp Get Line NUMERIC']);
while ($key ne chr(13) && $key ne chr(3)) {
if (length($line) <= $limit) {
$key = $self->sysop_get_key(NUMERIC, BLOCKING);
return ('') if (defined($key) && $key eq chr(3));
lib/BBS/Universal.pm view on Meta::CPAN
}
my @order = (qw(bbs_name bbs_hostname bbs_port));
my $bbs = {
'bbs_name' => '',
'bbs_hostname' => '',
'bbs_port' => '',
};
my $index = 0;
my $response = TRUE;
$self->sysop_output($table->round('BRIGHT BLUE')->draw());
print $self->{'ansi_meta'}->{'cursor'}->{'UP'}->{'out'} x 9, $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 19;
$bbs->{'bbs_name'} = $self->sysop_get_line(ECHO, 50, '');
$self->{'debug'}->DEBUG([' BBS Name: ' . $bbs->{'bbs_name'}]);
if ($bbs->{'bbs_name'} ne '' && length($bbs->{'bbs_name'}) > 3) {
print $self->{'ansi_meta'}->{'cursor'}->{'DOWN'}->{'out'} x 2, "\r", $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 19;
$bbs->{'bbs_hostname'} = $self->sysop_get_line(ECHO, 50, '');
$self->{'debug'}->DEBUG([' BBS Hostname: ' . $bbs->{'bbs_hostname'}]);
if ($bbs->{'bbs_hostname'} ne '' && length($bbs->{'bbs_hostname'}) > 5) {
print $self->{'ansi_meta'}->{'cursor'}->{'DOWN'}->{'out'} x 2, "\r", $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 19;
$bbs->{'bbs_port'} = $self->sysop_get_line(ECHO, 5, '');
$self->{'debug'}->DEBUG([' BBS Port: ' . $bbs->{'bbs_port'}]);
if ($bbs->{'bbs_port'} ne '' && $bbs->{'bbs_port'} =~ /^\d+$/) {
$self->{'debug'}->DEBUG([' Add to BBS List']);
my $sth = $self->{'dbh'}->prepare('INSERT INTO bbs_listing (bbs_name,bbs_hostname,bbs_port,bbs_poster_id) VALUES (?,?,?,1)');
$sth->execute($bbs->{'bbs_name'}, $bbs->{'bbs_hostname'}, $bbs->{'bbs_port'});
$sth->finish();
} else {
$response = FALSE;
}
lib/BBS/Universal.pm view on Meta::CPAN
} ## end sub sysop_bbs_list_bulk_import
sub sysop_ansi_output {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp ANSI Output']);
my $mlines = (exists($self->{'USER'}->{'max_rows'})) ? $self->{'USER'}->{'max_rows'} - 3 : 21;
my $lines = $mlines;
my $text = $self->ansi_decode(shift);
my $s_len = length($text);
my $nl = $self->{'ansi_meta'}->{'cursor'}->{'NEWLINE'}->{'out'};
my @lines = split(/\n/, $text);
my $size = $self->{'USER'}->{'max_rows'};
while (scalar(@lines)) {
my $line = shift(@lines);
print $line;
$size--;
if ($size <= 0) {
$size = $self->{'USER'}->{'max_rows'};
last unless ($self->scroll(("\n")));
lib/BBS/Universal/ANSI.pm view on Meta::CPAN
#
# Flatten the ansi_meta lookup to a simple, case-insensitive hash for a single-pass
# substitution of tokens like [% RED %], [% RESET %], etc.
#
if ($text =~ /CLS/i && $self->{'local_mode'}) {
my $ch = locate(($self->{'CACHE'}->get('START_ROW') + $self->{'CACHE'}->get('ROW_ADJUST')), 1) . cldown;
$text =~ s/\[\%\s+CLS\s+\%\]/$ch/gsi;
}
my %lookup;
for my $code (qw(foreground background special clear cursor attributes)) {
my $map = $self->{'ansi_meta'}->{$code} or next;
while (my ($name, $info) = each %{$map}) {
next unless (defined($info->{out}));
$lookup{ lc $name } = $info->{out};
}
} ## end for my $code (qw(foreground background special clear cursor attributes))
# Final single-pass replacement for remaining [% ... %] tokens.
# If token matches a lookup entry, substitute; otherwise if it's a named char use charnames;
# else leave token visible.
###
$text =~ s/\[\%\s*(.+?)\s*\%\]/
do {
my $tok = $1;
my $key = lc $tok;
if ( exists $lookup{$key} ) {
lib/BBS/Universal/ANSI.pm view on Meta::CPAN
sub ansi_output {
my $self = shift;
my $text = shift;
$self->{'debug'}->DEBUG(['Start ANSI Output']);
my $mlines = (exists($self->{'USER'}->{'max_rows'})) ? $self->{'USER'}->{'max_rows'} - 3 : 21;
my $lines = $mlines;
$text = $self->ansi_decode($text);
my $s_len = length($text);
my $nl = $self->{'ansi_meta'}->{'cursor'}->{'NEWLINE'}->{'out'};
foreach my $count (0 .. $s_len) {
my $char = substr($text, $count, 1);
if ($char eq "\n") {
if ($text !~ /$nl/ && !$self->{'local_mode'}) { # translate only if the file doesn't have ASCII newlines
$char = $nl;
}
$lines--;
if ($lines <= 0) {
$lines = $mlines;
lib/BBS/Universal/ANSI.pm view on Meta::CPAN
['SS3', "\eO", 'Single Shift 3'],
['CSI', "\e[", 'Control Sequence Introducer'],
['OSC', "\e]", 'Operating System Command'],
['SOS', "\eX", 'Start Of String'],
['ST', "\e\\", 'String Terminator'],
['DCS', "\eP", 'Device Control String'],
);
# Clear controls
my $clear = $pairs_to_map->(
['CLS', "\e[2J\e[H", 'Clear screen and place cursor at the top of the screen'],
['CLEAR', "\e[2J", 'Clear screen and keep cursor location'],
['CLEAR LINE', "\e[0K", 'Clear the current line from cursor'],
['CLEAR DOWN', "\e[0J", 'Clear from cursor position to bottom of the screen'],
['CLEAR UP', "\e[1J", 'Clear to the top of the screen from cursor position'],
);
# Cursor movement and control
my $cursor = $pairs_to_map->(
['BACKSPACE', chr(8), 'Backspace'],
['RETURN', chr(13), 'Carriage Return (ASCII 13)'],
['LINEFEED', chr(10), 'Line feed (ASCII 10)'],
['NEWLINE', chr(13) . chr(10), 'New line (ASCII 13 and ASCII 10)'],
['HOME', "\e[H", 'Place cursor at top left of the screen'],
['UP', "\e[A", 'Move cursor up one line'],
['DOWN', "\e[B", 'Move cursor down one line'],
['RIGHT', "\e[C", 'Move cursor right one space non-destructively'],
['LEFT', "\e[D", 'Move cursor left one space non-destructively'],
['NEXT LINE', "\e[E", 'Place the cursor at the beginning of the next line'],
['PREVIOUS LINE', "\e[F", 'Place the cursor at the beginning of the previous line'],
['SAVE', "\e[s", 'Save cureent cursor position'],
['RESTORE', "\e[u", 'Restore the cursor to the saved position'],
['CURSOR ON', "\e[?25h", 'Turn the cursor on'],
['CURSOR OFF', "\e[?25l", 'Turn the cursor off'],
['SCREEN 1', "\e[?1049l", 'Set display to screen 1'],
['SCREEN 2', "\e[?1049h", 'Set display to screen 2'],
);
# Text attributes
my $attributes = $pairs_to_map->(
['FONT 1', "\e[1m", 'ANSI FONT 1'],
['FONT 2', "\e[2m", 'ANSI FONT 2'],
['FONT 3', "\e[3m", 'ANSI FONT 3'],
['FONT 4', "\e[4m", 'ANSI FONT 4'],
lib/BBS/Universal/ANSI.pm view on Meta::CPAN
} @fg_extra;
my $background = $pairs_to_map->(
map { [ $_->[0], $_->[1], $_->[2] ] } @bg16,
map { [ $_->[0], $_->[1], $_->[2] ] } @bg_extra,
);
$self->{'ansi_meta'} = {
special => $special,
clear => $clear,
cursor => $cursor,
attributes => $attributes,
foreground => $foreground,
background => $background,
};
$self->{'debug'}->DEBUG(['End ANSI Initialize']);
return($self);
} ## end sub ansi_initialize
1;
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
my @names = (sort(keys %{ $self->{'ansi_meta'}->{'clear'} }));
while (scalar(@names)) {
my $name = shift(@names);
$text .= '[% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-63s', $name) . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', $self->ansi_description('clear', $name)) . ' [% BRIGHT GREEN %]│[% RESET %]' . "\n";
}
}
# CURSOR section
$text .= '[% BRIGHT GREEN %]â•žâ•â• [% BOLD %][% BRIGHT YELLOW %]CURSOR [% RESET %][% BRIGHT GREEN %]' . 'â•' x 55 . '╪' . 'â•' x 56 . 'â•¡[% RESET %]' . "\n";
{
my @names = (sort(keys %{ $self->{'ansi_meta'}->{'cursor'} }));
while (scalar(@names)) {
my $name = shift(@names);
$text .= "$bar " . sprintf('%-63s', $name) . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', $self->ansi_description('cursor', $name)) . " $bar\n";
}
$text .= "$bar " . sprintf('%-63s', 'LOCATE column,row') . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', 'Sets the cursor location') . " $bar\n";
$text .= "$bar " . sprintf('%-63s', 'SCROLL UP count') . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', 'Scrolls the screen up by "count" lines') . " $bar\n";
$text .= "$bar " . sprintf('%-63s', 'SCROLL DOWN count') . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', 'Scrolls the screen down by "count" lines') . " $bar\n";
}
# ATTRIBUTES section
$text .= '[% BRIGHT GREEN %]â•žâ•â• [% BOLD %][% BRIGHT YELLOW %]ATTRIBUTES [% RESET %][% BRIGHT GREEN %]' . 'â•' x 51 . '╪' . 'â•' x 56 . 'â•¡[% RESET %]' . "\n";
{
my @names = grep(!/FONT \d/, (sort(keys %{ $self->{'ansi_meta'}->{'attributes'} })));
foreach my $name (@names) {
if ($name =~ /FONT|HIDE|RING BELL/) {
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
} ## end sub sysop_hostname
sub sysop_locate_middle {
my $self = shift;
my $color = (scalar(@_)) ? shift : 'B_WHITE';
my ($wsize, $hsize, $wpixels, $hpixels) = GetTerminalSize();
my $middle = int($wsize / 2);
my $string;
if ($color =~ /^B_/) {
$string = "\r" . $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x $middle . $self->{'ansi_meta'}->{'background'}->{$color}->{'out'} . ' ' . $self->{'ansi_meta'}->{'attributes'}->{'RESET'}->{'out'};
} else {
$string = "\r" . $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x $middle . $self->{'ansi_meta'}->{'foreground'}->{$color}->{'out'} . ' ' . $self->{'ansi_meta'}->{'attributes'}->{'RESET'}->{'out'};
}
return ($string);
} ## end sub sysop_locate_middle
sub sysop_memory {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Memory']);
my $memory = `nice free`;
my @mem = split(/\n$/, $memory);
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
$table = Text::SimpleTable->new(11, 80);
$table->row('TITLE', "\n" . charnames::string_vianame('OVERLINE') x 80);
$table->row('DESCRIPTION', "\n" . charnames::string_vianame('OVERLINE') x 80);
my $text = $table->twin('MAGENTA')->draw();
while ($text =~ / (TITLE|DESCRIPTION) /) {
my $ch = $1;
my $new = '[% BRIGHT YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$self->sysop_output("\n$text");
print $self->{'ansi_meta'}->{'cursor'}->{'UP'}->{'out'} x 5, $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 16;
my $title = $self->sysop_get_line(ECHO, 80, '');
if ($title ne '') {
print "\r", $self->{'ansi_meta'}->{'cursor'}->{'DOWN'}->{'out'}, $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 16;
my $description = $self->sysop_get_line(ECHO, 80, '');
if ($description ne '') {
$sth = $self->{'dbh'}->prepare('INSERT INTO file_categories (title,description) VALUES (?,?)');
$sth->execute($title, $description);
$sth->finish();
print "\n\nNew Entry Added\n";
} else {
print "\n\nNevermind\n";
}
} else {
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
my $mode = $self->{'USER'}->{'text_mode'};
my $timeout = $self->{'USER'}->{'timeout'} * 60;
local $/ = "\x{00}";
ReadMode 'ultra-raw';
$key = ($blocking) ? ReadKey($timeout) : ReadKey(-1);
ReadMode 'restore';
threads->yield;
return ($key) if ($key eq chr(13));
if ($key eq chr(127)) {
$key = $self->{'ansi_meta'}->{'cursor'}->{'BACKSPACE'}->{'out'};
}
if ($echo == NUMERIC && defined($key)) {
unless ($key =~ /[0-9]/) {
$key = '';
}
}
threads->yield;
return ($key);
} ## end sub sysop_get_key
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
} else {
if ($echo == STRING || $echo == ECHO || $echo == NUMERIC || $echo == HOST) {
$limit = shift;
}
$line = shift;
} ## end else [ if (ref($type) eq 'HASH')]
chomp($line);
$self->{'debug'}->DEBUGMAX([$type, $echo, $line]);
print $line if ($line ne '');
my $mode = 'ANSI';
my $bs = $self->{'ansi_meta'}->{'cursor'}->{'BACKSPACE'}->{'out'};
if ($echo == RADIO) {
$self->{'debug'}->DEBUG([' SysOp Get Line RADIO']);
my $mapping;
my @menu_choices = @{$self->{'MENU CHOICES'}};
foreach my $choice (@{$choices}) {
$mapping->{ shift(@menu_choices) } = {
'command' => $choice,
'color' => 'WHITE',
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
$line = '';
} else {
$line = $mapping->{$key}->{'command'};
}
} elsif ($echo == BOOLEAN) {
$self->{'debug'}->DEBUG([' SysOp Get Line BOOLEAN']);
do {
$key = $self->sysop_get_key(SILENT, BLOCKING);
if (uc($key) eq 'T') {
$line = 'ON';
print $self->{'ansi_meta'}->{'cursor'}->{'LEFT'}->{'out'} x 5, 'ON', clline;
} elsif (uc($key) eq 'F') {
$line = 'OFF';
print $self->{'ansi_meta'}->{'cursor'}->{'LEFT'}->{'out'} x 4, 'OFF', clline;
} elsif ($key ne chr(13) && $key ne chr(3)) {
print chr(7);
}
} until ($key eq chr(13) or $key eq chr(3));
} elsif ($echo == NUMERIC) {
$self->{'debug'}->DEBUG([' SysOp Get Line NUMERIC']);
while ($key ne chr(13) && $key ne chr(3)) {
if (length($line) <= $limit) {
$key = $self->sysop_get_key(NUMERIC, BLOCKING);
return ('') if (defined($key) && $key eq chr(3));
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
}
my @order = (qw(bbs_name bbs_hostname bbs_port));
my $bbs = {
'bbs_name' => '',
'bbs_hostname' => '',
'bbs_port' => '',
};
my $index = 0;
my $response = TRUE;
$self->sysop_output($table->round('BRIGHT BLUE')->draw());
print $self->{'ansi_meta'}->{'cursor'}->{'UP'}->{'out'} x 9, $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 19;
$bbs->{'bbs_name'} = $self->sysop_get_line(ECHO, 50, '');
$self->{'debug'}->DEBUG([' BBS Name: ' . $bbs->{'bbs_name'}]);
if ($bbs->{'bbs_name'} ne '' && length($bbs->{'bbs_name'}) > 3) {
print $self->{'ansi_meta'}->{'cursor'}->{'DOWN'}->{'out'} x 2, "\r", $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 19;
$bbs->{'bbs_hostname'} = $self->sysop_get_line(ECHO, 50, '');
$self->{'debug'}->DEBUG([' BBS Hostname: ' . $bbs->{'bbs_hostname'}]);
if ($bbs->{'bbs_hostname'} ne '' && length($bbs->{'bbs_hostname'}) > 5) {
print $self->{'ansi_meta'}->{'cursor'}->{'DOWN'}->{'out'} x 2, "\r", $self->{'ansi_meta'}->{'cursor'}->{'RIGHT'}->{'out'} x 19;
$bbs->{'bbs_port'} = $self->sysop_get_line(ECHO, 5, '');
$self->{'debug'}->DEBUG([' BBS Port: ' . $bbs->{'bbs_port'}]);
if ($bbs->{'bbs_port'} ne '' && $bbs->{'bbs_port'} =~ /^\d+$/) {
$self->{'debug'}->DEBUG([' Add to BBS List']);
my $sth = $self->{'dbh'}->prepare('INSERT INTO bbs_listing (bbs_name,bbs_hostname,bbs_port,bbs_poster_id) VALUES (?,?,?,1)');
$sth->execute($bbs->{'bbs_name'}, $bbs->{'bbs_hostname'}, $bbs->{'bbs_port'});
$sth->finish();
} else {
$response = FALSE;
}
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
} ## end sub sysop_bbs_list_bulk_import
sub sysop_ansi_output {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp ANSI Output']);
my $mlines = (exists($self->{'USER'}->{'max_rows'})) ? $self->{'USER'}->{'max_rows'} - 3 : 21;
my $lines = $mlines;
my $text = $self->ansi_decode(shift);
my $s_len = length($text);
my $nl = $self->{'ansi_meta'}->{'cursor'}->{'NEWLINE'}->{'out'};
my @lines = split(/\n/, $text);
my $size = $self->{'USER'}->{'max_rows'};
while (scalar(@lines)) {
my $line = shift(@lines);
print $line;
$size--;
if ($size <= 0) {
$size = $self->{'USER'}->{'max_rows'};
last unless ($self->scroll(("\n")));
src/Universal.pm view on Meta::CPAN
'exit' => 'threads_only',
'stringify',
);
use Debug::Easy;
use DateTime;
use DBI;
use DBD::mysql;
use File::Basename;
use Time::HiRes qw(time sleep);
use Term::ReadKey;
use Term::ANSIScreen qw( :cursor :screen );
use Term::ANSIColor;
use Text::Format;
use Text::SimpleTable;
use List::Util qw(min max);
use IO::Socket qw(AF_INET SOCK_STREAM SHUT_WR SHUT_RDWR SHUT_RD);
use Cache::Memcached::Fast;
use Number::Format 'format_number';
use XML::RSS::LibXML;
use File::Path;
use File::Which;
src/Universal.pm view on Meta::CPAN
$self->parse_telnet_escape(ord($command), ord($option));
$escape = TRUE;
} ## end if ($key eq chr(255))
} until (!$escape || $self->is_connected());
ReadMode 'restore', $self->{'cl_socket'};
threads->yield;
} ## end elsif ($self->is_connected...)
return ($key) if ($key eq chr(13));
if ($key eq chr(127) or $key eq chr(7)) {
if ($mode eq 'ANSI') {
$key = $self->{'ansi_meta'}->{'cursor'}->{'BACKSPACE'}->{'out'};
} elsif ($mode eq 'ATASCII') {
$key = $self->{'atascii_meta'}->{'BACKSPACE'}->{'out'};
} elsif ($mode eq 'PETSCII') {
$key = $self->{'petscii_meta'}->{'BACKSPACE'}->{'out'};
} else {
$key = $self->{'ascii_meta'}->{'BACKSPACE'}->{'out'};
}
$self->output("$key $key") if ($echo);
} ## end if ($key eq chr(127) or...)
threads->yield;
src/Universal.pm view on Meta::CPAN
$self->{'debug'}->DEBUG(['Start Get Line']);
$self->flush_input();
my $key;
$self->output($line) if ($line ne '');
my $mode = $self->{'USER'}->{'text_mode'};
my $backspace;
if ($mode eq 'ANSI') {
$backspace = $self->{'ansi_meta'}->{'cursor'}->{'BACKSPACE'}->{'out'};
} elsif ($mode eq 'ATASCII') {
$backspace = $self->{'atascii_meta'}->{'BACKSPACE'}->{'out'};
} elsif ($mode eq 'PETSCII') {
$backspace = $self->{'petscii_meta'}->{'BACKSPACE'}->{'out'};
} else {
$backspace = $self->{'ascii_meta'}->{'BACKSPACE'}->{'out'};
}
if ($echo == PASSWORD) {
$self->{'debug'}->DEBUG([' Mode: PASSWORD']);
( run in 1.936 second using v1.01-cache-2.11-cpan-39bf76dae61 )