BBS-Universal
view release on metacpan or search on metacpan
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
} ## end if ($count > $srow)
} ## end while (scalar(@{$left_ref...}))
return $table->twin('ORANGE')->draw();
} ## end sub _render_table
# Helper: substitutions registry
sub _substitutions_for_mode {
my ($mode) = @_;
return [
# Common header highlight
[qr/ (C|DESCRIPTION|TYPE|SYSOP MENU COMMANDS|SYSOP TOKENS|USER MENU COMMANDS|USER TOKENS|ATASCII TOKENS|PETSCII TOKENS|ASCII TOKENS) /, ' [% BRIGHT YELLOW %]$1[% RESET %] '],
# USER/SYSOP italicize "color" and "text"
($mode =~ /USER|SYSOP/ ? ([qr/color/, '[% ITALIC %][% FAINT %]color[% RESET %]'], [qr/text/, '[% ITALIC %][% FAINT %]text[% RESET %]'],) : ()),
# PETSCII color names mapped to ANSI
($mode eq 'PETSCII' ? ([qr/│ (WHITE)/, '│ [% BRIGHT WHITE %]$1[% RESET %]'], [qr/│ (YELLOW)/, '│ [% YELLOW %]$1[% RESET %]'], [qr/│ (CYAN)/, '│ [% CYAN %]$1[% RESET %]'], [qr/│ (GREEN)/, '│ [% GREEN %]$1[% RESET %]'], [qr/│ ...
];
} ## end sub _substitutions_for_mode
sub _apply_substitutions {
my ($text, $rules) = @_;
for my $rule (@$rules) {
my ($re, $rep) = @$rule;
$text =~ s/$re/$rep/g;
}
return $text;
} ## end sub _apply_substitutions
# Optional: isolate the very large ANSI catalog builder to its own function (preserving behavior)
sub _render_ansi_catalog {
my ($self, $wsize) = @_;
# This preserves the original logic and content, but organizes the huge string building
# into manageable sections. The content below is copied verbatim from your ANSI branch,
# with only structural arrangement and minor variable scoping cleanups.
# Header banner
my $text .= '[% BRIGHT GREEN %]â•' . '─' x 122 . 'â•®[% RESET %]' . "\n";
$text .= q{[% BRIGHT GREEN %]│[% BRIGHT WHITE %] _ _ _ ____ ___ _____ ___ _ _______ _ _ ____ [% BRIGHT GREEN %]│[% RESET %]} . "\n";
$text .= q{[% BRIGHT GREEN %]│[% BRIGHT WHITE %] / \ | \ | / ___|_ _| |_ _/ _ \| |/ / ____| \ | / ___| [% BRIGHT GREEN %]│[% RESET %]} . "\n";
$text .= q{[% BRIGHT GREEN %]│[% BRIGHT WHITE %] / _ \ | \| \___ \| | | || | | | ' /| _| | \| \___ \ [% BRIGHT GREEN %]│[% RESET %]} . "\n";
$text .= q{[% BRIGHT GREEN %]│[% BRIGHT WHITE %] / ___ \| |\ |___) | | | || |_| | . \| |___| |\ |___) | [% BRIGHT GREEN %]│[% RESET %]} . "\n";
$text .= q{[% BRIGHT GREEN %]│[% BRIGHT WHITE %] /_/ \_\_| \_|____/___| |_| \___/|_|\_\_____|_| \_|____/ [% BRIGHT GREEN %]│[% RESET %]} . "\n";
$text .= q{[% BRIGHT GREEN %]│[% BRIGHT WHITE %] [% BRIGHT GREEN %]│[% RESET %]} . "\n";
my $bar = '[% BRIGHT GREEN %]│[% RESET %]';
# CLEAR section
$text .= '[% BRIGHT GREEN %]â•žâ•â• [% BOLD %][% BRIGHT YELLOW %]CLEAR [% RESET %][% BRIGHT GREEN %]' . 'â•' x 56 . '╤' . 'â•' x 56 . 'â•¡[% RESET %]' . "\n";
{
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/) {
$text .= "$bar " . sprintf('%-63s', $name) . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', $self->ansi_description('attributes', $name)) . " $bar\n";
$text .= "$bar " . sprintf('%-63s', 'FONT 1-9') . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', 'Set specific font (1-9)') . " $bar\n" if ($name eq 'FONT DEFAULT');
} else {
$text .= '[% BRIGHT GREEN %]│[% RESET %][% ' . $name . ' %]' . sprintf(' %-63s', $name) . ' [% RESET %][% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', $self->ansi_description('attributes', $name)) . " $bar\n";
}
} ## end foreach my $name (@names)
$text .= "$bar " . sprintf('%-62s', 'UNDERLINE COLOR RGB red,green,blue ') . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s', 'Set the underline color using RGB') . " $bar\n";
}
# Colors
{
my $f;
my $b;
foreach my $code ('ANSI 3 BIT','ANSI 4 BIT','ANSI 8 BIT','ANSI 24 BIT') {
if ($code eq 'ANSI 3 BIT') {
$text .= '[% BRIGHT GREEN %]â•žâ•â• [% BOLD %][% BRIGHT YELLOW %]' . sprintf('%-11s',$code) . ' [% RESET %][% BRIGHT GREEN %]â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•¤â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•...
} else {
$text .= '[% BRIGHT GREEN %]â•žâ•â• [% BOLD %][% BRIGHT YELLOW %]' . sprintf('%-11s',$code) . ' [% RESET %][% BRIGHT GREEN %]â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•ªâ•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•...
}
if ($code eq 'ANSI 8 BIT') {
foreach my $count (16 .. 231) {
$text .= '[% BRIGHT GREEN %]│[% RESET %][% COLOR ' . $count . ' %]' . sprintf(' %-29s ',"COLOR $count") . '[% RESET %][% BRIGHT GREEN %]│[% RESET %][% BLACK %][% B_COLOR ' . $count . ' %]' . sprintf(' %-31s ', "B_COLOR $count") . '[% RESET %...
}
foreach my $count (0 .. 23) {
$text .= '[% BRIGHT GREEN %]│[% RESET %][% GRAY ' . $count . ' %]' . sprintf(' %-29s ', "GRAY $count") . '[% RESET %][% BRIGHT GREEN %]│[% RESET %][% BLACK %][% B_GRAY ' . $count . ' %]' . sprintf(' %-31s ', "B_GRAY $count") . '[% RESET %][%...
}
}
foreach my $name (grep(!/COLOR |GRAY /,sort(keys %{$self->{'ansi_meta'}->{'foreground'}}))) {
if ($self->ansi_type($self->{'ansi_meta'}->{'foreground'}->{$name}->{'out'}) eq $code) {
if ($name =~ /^(DEFAULT|NAVY|COLOR 16|BLACK|MEDIUM BLUE|ARMY GREEN|BISTRE|BULGARIAN ROSE|CHARCOAL|COOL BLACK|DARK BLUE|DARK GREEN|DARK JUNGLE GREEN|DARK MIDNIGHT BLUE|DUKE BLUE|EGYPTIAN BLUE|MEDIUM JUNGLE GREEN|MIDNIGHT BLUE|NAVY BLUE|ONYX|OXFOR...
$text .= '[% BRIGHT GREEN %]│[% RESET %]' . sprintf(' %-29s ',$name) . '[% RESET %][% BRIGHT GREEN %]│[% RESET %][% B_' . $name . ' %]' . sprintf(' %-31s ', "B_${name}") . '[% RESET %]│' . sprintf(' %-54s ',$self->ansi_description('foregr...
} else {
$text .= '[% BRIGHT GREEN %]│[% RESET %][% ' . $name . ' %]' . sprintf(' %-29s ',$name) . '[% RESET %][% BRIGHT GREEN %]│[% RESET %][% BLACK %][% B_' . $name . ' %]' . sprintf(' %-31s ', "B_${name}") . '[% RESET %][% BRIGHT GREEN %]│[% RE...
}
}
}
}
$text .= '[% BRIGHT GREEN %]│[% RESET %]' . sprintf(' %-29s ','RGB red,green,blue') . '[% RESET %][% BRIGHT GREEN %]│[% RESET %]' . sprintf(' %-31s ', 'B_RGB red,green,blue') . '[% RESET %][% BRIGHT GREEN %]│[% RESET %]' . sprintf(' %-5...
}
# Special
$text .= '[% BRIGHT GREEN %]â•žâ•â• [% BOLD %][% BRIGHT YELLOW %]SPECIAL [% RESET %][% BRIGHT GREEN %]â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•§â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â...
{
my @names = (sort(keys %{$self->{'ansi_meta'}->{'special'}}));
while(scalar(@names)) {
my $name = shift(@names);
$text .= "$bar " . sprintf('%-63s',$name) . ' [% BRIGHT GREEN %]│[% RESET %] ' . sprintf('%-54s',$self->ansi_description('special',$name)) . " $bar\n";
}
$text .= '[% BRIGHT GREEN %]│ ─────────────────────────────────────────────────────────────── │ ─────â...
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
$row = shift;
$animate = shift;
}
my $key;
do {
$self->{'CACHE'}->set('SHOW_STATUS', FALSE);
ReadMode 'ultra-raw';
$key = ReadKey(0.25);
ReadMode 'restore';
$self->sysop_animate($row) if ($animate);
threads->yield();
$self->{'CACHE'}->set('SHOW_STATUS', TRUE);
} until (defined($key));
return ($key);
} ## end sub sysop_keypress
sub sysop_animate {
my $self = shift;
my $row = shift;
my @color = @{ $self->{'sysop_menu_colors'} };
my $text = "\e[s" . "\e[1;91H\e[48;2;0;0;96m\e[93m " . $self->clock() . " \e[" . $row++ . ";1H\e[" . $color[0] . "mâ—¥\e[" . ($color[0] + 10) . "m \e[0m\e[" . $color[0] . "m\e[7mâ—¥\e[0m" . "\e[" . $row++ . ";2H\e[" . $color[1] . "mâ—¥\e[" . ($co...
$self->{'CACHE'}->set('SHOW_STATUS', FALSE);
print $text;
$self->{'CACHE'}->set('SHOW_STATUS', TRUE);
my $l = pop(@color);
unshift(@color, $l);
$self->{'sysop_menu_colors'} = \@color;
} ## end sub sysop_animate
sub sysop_ip_address {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp IP Address']);
chomp(my $ip = `nice hostname -I`);
$self->{'debug'}->DEBUG([" SysOp IP Address: $ip", 'End SysOp IP Address']);
return ($ip);
} ## end sub sysop_ip_address
sub sysop_hostname {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Hostname']);
chomp(my $hostname = `nice hostname`);
$self->{'debug'}->DEBUG([" SysOp Hostname: $hostname", 'End SysOp Hostname']);
return ($hostname);
} ## 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);
my $output = '[% BLACK %][% B_GREEN %] ' . shift(@mem) . ' [% RESET %]' . "\n";
while (scalar(@mem)) {
$output .= shift(@mem) . "\n";
}
if ($output =~ /(Mem\: )/) {
my $ch = '[% BLACK %][% B_GREEN %] ' . $1 . ' [% RESET %]';
$output =~ s/Mem\: /$ch/;
}
if ($output =~ /(Swap\: )/) {
my $ch = '[% BLACK %][% B_GREEN %] ' . $1 . ' [% RESET %]';
$output =~ s/Swap\: /$ch/;
}
$self->{'debug'}->DEBUG(['End SysOp Memory']);
return ($output);
} ## end sub sysop_memory
sub sysop_true_false {
my $self = shift;
my $boolean = shift;
my $mode = shift;
$boolean = $boolean + 0;
if ($mode eq 'TF') {
return (($boolean) ? 'TRUE' : 'FALSE');
} elsif ($mode eq 'YN') {
return (($boolean) ? 'YES' : 'NO');
} elsif ($mode eq 'OO') {
return(($boolean) ? 'ON' : 'OFF');
}
return ($boolean);
} ## end sub sysop_true_false
sub sysop_list_users {
my $self = shift;
my $list_mode = shift;
$self->{'debug'}->DEBUG(['Start SysOp List Users']);
my ($wsize, $hsize, $wpixels, $hpixels) = GetTerminalSize();
my $table;
my $date_format = $self->configuration('DATE FORMAT');
$date_format =~ s/YEAR/\%Y/;
$date_format =~ s/MONTH/\%m/;
$date_format =~ s/DAY/\%d/;
my $name_width = 15;
my $value_width = $wsize - 22;
my $sth;
my @order;
my $sql;
if ($list_mode =~ /DETAILED/) {
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
my $ch = $1;
my $new = '[% BRIGHT YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$self->sysop_output($text . "\n");
$self->sysop_prompt('Choose ID (< = Nevermind)');
my $line;
do {
$line = uc($self->sysop_get_line(ECHO, 3, ''));
} until ($line =~ /^(\d+|\<)/i);
my $response = FALSE;
if ($line >= 1 && $line <= $max_id) {
$sth = $self->{'dbh'}->prepare('UPDATE users SET file_category=? WHERE id=1');
$sth->execute($line);
$sth->finish();
$self->{'USER'}->{'file_category'} = $line + 0;
$response = TRUE;
} ## end if ($line >= 1 && $line...)
$self->{'debug'}->DEBUG(['End SysOp Select File Category']);
return ($response);
} ## end sub sysop_select_file_category
sub sysop_edit_file_categories {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Edit File Categories']);
my $sth = $self->{'dbh'}->prepare('SELECT * FROM file_categories');
$sth->execute();
my $table = Text::SimpleTable->new(3, 30, 50);
$table->row('ID', 'TITLE', 'DESCRIPTION');
$table->hr();
while (my $row = $sth->fetchrow_hashref()) {
$table->row($row->{'id'}, $row->{'title'}, $row->{'description'});
}
$sth->finish();
my $text = $table->boxes->draw();
while ($text =~ / (ID|TITLE|DESCRIPTION) /) {
my $ch = $1;
my $new = '[% BRIGHT YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$self->sysop_output("$text\n");
$self->sysop_prompt('Choose ID (A = Add, < = Nevermind)');
my $line;
do {
$line = uc($self->sysop_get_line(ECHO, 3, ''));
} until ($line =~ /^(\d+|A|\<)/i);
if ($line eq 'A') { # Add
$self->{'debug'}->DEBUG([' SysOp Edit File Categories Add']);
print "\nADD NEW FILE CATEGORY\n";
$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 {
print "\n\n\nNevermind\n";
}
} elsif ($line =~ /\d+/) { # Edit
$self->{'debug'}->DEBUG([' SysOp Edit File Categories Edit']);
}
$self->{'debug'}->DEBUG(['Start SysOp Edit File Categories']);
return (TRUE);
} ## end sub sysop_edit_file_categories
sub sysop_vertical_heading {
my $self = shift;
my $text = shift;
$self->{'debug'}->DEBUG(['Start SysOp Vertical Heading']);
my $heading = '';
for (my $count = 0; $count < length($text); $count++) {
$heading .= substr($text, $count, 1) . "\n";
}
$self->{'debug'}->DEBUG(['End SysOp Vertical Heading']);
return ($heading);
} ## end sub sysop_vertical_heading
sub sysop_view_configuration {
my $self = shift;
my $view = shift;
$self->{'debug'}->DEBUG(['Start SysOp View Configuration']);
# Get maximum widths
my $name_width = 6;
my $value_width = 80;
foreach my $cnf (keys %{ $self->configuration() }) {
if ($cnf eq 'STATIC') {
foreach my $static (keys %{ $self->{'CONF'}->{$cnf} }) {
$name_width = max(length($static), $name_width);
$value_width = max(length($self->{'CONF'}->{$cnf}->{$static}), $value_width);
}
} else {
$name_width = max(length($cnf), $name_width);
$value_width = max(length($self->{'CONF'}->{$cnf}), $value_width);
}
} ## end foreach my $cnf (keys %{ $self...})
# Assemble table
my $table = ($view) ? Text::SimpleTable->new($name_width, $value_width) : Text::SimpleTable->new(6, $name_width, $value_width);
if ($view) {
$table->row('STATIC NAME', 'STATIC VALUE');
$table->hr();
}
foreach my $conf (sort(keys %{ $self->{'CONF'}->{'STATIC'} })) {
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
'THREAD MULTIPLIER' => { 'max' => 2, 'type' => NUMERIC, },
'PORT' => { 'max' => 5, 'type' => NUMERIC, },
'DEFAULT BAUD RATE' => { 'max' => 5, 'type' => RADIO, 'choices' => ['300', '600', '1200', '2400', '4800', '9600', '19200', '38400', '57600', '115200', 'FULL'], },
'DEFAULT TEXT MODE' => { 'max' => 7, 'type' => RADIO, 'choices' => ['ANSI', 'ASCII', 'ATASCII', 'PETSCII'], },
'DEFAULT TIMEOUT' => { 'max' => 3, 'type' => NUMERIC, },
'FILES PATH' => { 'max' => 60, 'type' => STRING, },
'LOGIN TRIES' => { 'max' => 1, 'type' => NUMERIC, },
'MEMCACHED HOST' => { 'max' => 20, 'type' => HOST, },
'MEMCACHED NAMESPACE' => { 'max' => 32, 'type' => STRING, },
'MEMCACHED PORT' => { 'max' => 5, 'type' => NUMERIC, },
'DATE FORMAT' => { 'max' => 14, 'type' => RADIO, 'choices' => ['MONTH/DAY/YEAR', 'DAY/MONTH/YEAR', 'YEAR/MONTH/DAY',], },
'SYSOP ANIMATED MENU' => { 'max' => 5, 'type' => BOOLEAN, 'choices' => ['ON', 'OFF'], },
'USE DUF' => { 'max' => 5, 'type' => BOOLEAN, 'choices' => ['ON', 'OFF'], },
'PLAY SYSOP SOUNDS' => { 'max' => 5, 'type' => BOOLEAN, 'choices' => ['ON', 'OFF'], },
};
my $choice;
do {
$choice = uc($self->sysop_keypress());
} until ($choice =~ /[A-R]|Z/i);
if ($choice =~ /Z/i) {
print "BACK\n";
return (FALSE);
}
$choice = ("$choice" =~ /[A-Y]/i) ? $choice = (ord($choice) - 65) : $choice;
my @conf = grep(!/STATIC|AUTHOR/, sort(keys %{ $self->{'CONF'} }));
if ($types->{ $conf[$choice] }->{'type'} == RADIO || $types->{ $conf[$choice] }->{'type'} == BOOLEAN) {
print '(Edit) ', $conf[$choice], ' (' . join(' ', @{ $types->{ $conf[$choice] }->{'choices'} }) . ') ', charnames::string_vianame('BLACK RIGHT-POINTING TRIANGLE'), ' ';
} else {
print '(Edit) ', $conf[$choice], ' ', charnames::string_vianame('BLACK RIGHT-POINTING TRIANGLE'), ' ';
}
my $string;
$self->{'debug'}->DEBUGMAX([$self->configuration()]);
$string = $self->sysop_get_line($types->{ $conf[$choice] }, $self->configuration($conf[$choice]));
my $response = TRUE;
if ($string eq '') {
$response = FALSE;
} else {
$self->configuration($conf[$choice], $string);
}
$self->{'debug'}->DEBUG(['End SysOp Edit Configuration']);
return ($response);
} ## end sub sysop_edit_configuration
sub sysop_get_key {
my $self = shift;
my $echo = shift;
my $blocking = shift;
my $key = undef;
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
sub sysop_get_line {
my $self = shift;
my $echo = shift;
my $type = $echo;
my $line;
my $limit;
my $choices;
my $key;
$self->{'CACHE'}->set('SHOW_STATUS', FALSE);
$self->{'debug'}->DEBUG(['Start SysOp Get Line']);
$self->flush_input();
if (ref($type) eq 'HASH') {
$limit = $type->{'max'};
if (exists($type->{'choices'})) {
$choices = $type->{'choices'};
if (exists($type->{'default'})) {
$line = $type->{'default'};
} else {
$line = shift;
}
} ## end if (exists($type->{'choices'...}))
$echo = $type->{'type'};
} 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',
'access_level' => 'USER',
'text' => $choice,
}
}
print "\n";
$self->sysop_show_choices($mapping);
$self->sysop_prompt('Choose');
my $key;
do {
$key = uc($self->sysop_get_key(SILENT, BLOCKING));
} until (exists($mapping->{$key}) || $key eq chr(3));
if ($key eq chr(3)) {
$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));
if (defined($key) && $key ne '') {
if ($key eq $bs || $key eq chr(127)) {
my $len = length($line);
if ($len > 0) {
print "$key $key";
chop($line);
}
} elsif ($key ne chr(13) && $key ne chr(3) && $key ne chr(10) && $key =~ /[0-9]/) {
print $key;
$line .= $key;
} else {
print chr(7);
}
} ## end if (defined($key) && $key...)
} else {
$key = $self->sysop_get_key(SILENT, BLOCKING);
if (defined($key) && $key eq chr(3)) {
return ('');
}
if (defined($key) && ($key eq $bs || $key eq chr(127))) {
$key = $bs;
print "$key $key";
chop($line);
} else {
print chr(7);
}
} ## end else [ if (length($line) <= $limit)]
} ## end while ($key ne chr(13) &&...)
} elsif ($echo == HOST) {
$self->{'debug'}->DEBUG([' SysOp Get Line HOST']);
while ($key ne chr(13) && $key ne chr(3)) {
if (length($line) <= $limit) {
$key = $self->sysop_get_key(SILENT, BLOCKING);
return ('') if (defined($key) && $key eq chr(3));
if (defined($key) && $key ne '') {
if ($key eq $bs || $key eq chr(127)) {
my $len = length($line);
if ($len > 0) {
$self->sysop_output("$key $key");
chop($line);
}
} elsif ($key ne chr(13) && $key ne chr(3) && $key ne chr(10) && $key =~ /[a-z]|[0-9]|\./) {
print lc($key);
$line .= lc($key);
} else {
print chr(7);
}
} ## end if (defined($key) && $key...)
} else {
$key = $self->sysop_get_key(SILENT, BLOCKING);
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
my $bbs = $sth->fetchrow_hashref();
$sth->finish();
my $table = Text::SimpleTable->new(6, 12, 50);
my $index = 1;
$table->row('CHOICE', 'FIELD NAME', 'VALUE');
$table->hr();
foreach my $name (qw(bbs_id bbs_poster bbs_name bbs_hostname bbs_port)) {
if ($name =~ /bbs_id|bbs_poster/) {
$table->row(' ', $name, $bbs->{$name});
} else {
$table->row($index, $name, $bbs->{$name});
$index++;
}
} ## end foreach my $name (qw(bbs_id bbs_poster bbs_name bbs_hostname bbs_port))
$self->sysop_output($table->round('BRIGHT BLUE')->draw());
$self->sysop_prompt('Edit which field (Z=Nevermind)');
my $choice;
do {
$choice = $self->sysop_keypress();
} until ($choice =~ /[1-3]|Z/i);
if ($choice =~ /\D/) {
print "BACK\n";
return (FALSE);
}
$self->sysop_prompt($choices[$choice] . ' (' . $bbs->{ $choices[$choice] } . ') ');
my $width = ($choices[$choice] eq 'bbs_port') ? 5 : 50;
my $new = $self->sysop_get_line(ECHO, $width, '');
if ($new eq '') {
$self->{'debug'}->DEBUG(['sysop_edit_bbs end']);
return (FALSE);
}
$sth = $self->{'dbh'}->prepare('UPDATE bbs_listing SET ' . $choices[$choice] . '=? WHERE bbs_id=?');
$sth->execute($new, $bbs->{'bbs_id'});
$sth->finish();
} else {
$sth->finish();
}
$self->{'debug'}->DEBUG(['End SysOp Edit BBS']);
return (TRUE);
} ## end sub sysop_edit_bbs
sub sysop_add_bbs {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Add BBS']);
my $table = Text::SimpleTable->new(14, 50);
foreach my $name ('BBS NAME', 'HOSTNAME/PHONE', 'PORT') {
my $count = ($name eq 'PORT') ? 5 : 50;
$table->row($name, "\n" . charnames::string_vianame('OVERLINE') x $count);
$table->hr() unless ($name eq 'PORT');
}
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;
}
} else {
$response = FALSE;
}
} else {
$response = FALSE;
}
$self->{'debug'}->DEBUG(['End SysOp Add BBS']);
return ($response);
} ## end sub sysop_add_bbs
sub sysop_delete_bbs {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Delete BBS']);
$self->sysop_prompt('Please enter the ID, the hostname, or the BBS name to delete');
my $search;
$search = $self->sysop_get_line(ECHO, 50, '');
if ($search eq '') {
return (FALSE);
}
print "\r", cldown, "\n";
my $sth = $self->{'dbh'}->prepare('SELECT * FROM bbs_listing_view WHERE bbs_id=? OR bbs_name=? OR bbs_hostname=?');
$sth->execute($search, $search, $search);
if ($sth->rows() > 0) {
my $bbs = $sth->fetchrow_hashref();
$sth->finish();
my $table = Text::SimpleTable->new(12, 50);
$table->row('FIELD NAME', 'VALUE');
$table->hr();
foreach my $name (qw(bbs_id bbs_poster bbs_name bbs_hostname bbs_port)) {
$table->row($name, $bbs->{$name});
}
$self->sysop_output($table->round('RED')->draw());
print 'Are you sure that you want to delete this BBS from the list (Y|N)? ';
my $choice = $self->sysop_decision();
unless ($choice) {
$self->{'debug'}->DEBUG(['End SysOp Delete BBS']);
return (FALSE);
}
$sth = $self->{'dbh'}->prepare('DELETE FROM bbs_listing WHERE bbs_id=?');
$sth->execute($bbs->{'bbs_id'});
} ## end if ($sth->rows() > 0)
$sth->finish();
$self->{'debug'}->DEBUG(['End SysOp Delete BBS']);
return (TRUE);
} ## end sub sysop_delete_bbs
sub sysop_add_file_category {
my $self = shift;
lib/BBS/Universal/SysOp.pm view on Meta::CPAN
} ## end if (defined($title) &&...)
} ## end if (-e $filename)
} ## end while (scalar(@names))
} else {
$self->sysop_output("\n\n" . '[% BRIGHT RED %]NO FILES TO ADD![% RESET %] ');
sleep 2;
}
} else {
print colored(['yellow'], 'No unmapped files found'), "\n";
sleep 2;
}
$self->{'debug'}->DEBUG(['End SysOp Add File']);
} ## end sub sysop_add_file
sub sysop_bbs_list_bulk_import {
my $self = shift;
my $filename = $self->configuration('BBS ROOT') . "/bbs_list.txt";
$self->{'debug'}->DEBUG(['Start SysOp BBS List Bulk Import of ' . $filename]);
if (-e "$filename") {
$self->sysop_output("\n\nImporting/merging BBS list from bbs_list.txt\n\n");
$self->sysop_output('[% GREEN %]â•â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”€â”¬â”€...
$self->sysop_output('[% GREEN %]│[% RESET %] NAME [% GREEN %]│[% RESET %] HOSTNAME/PHONE [% GREEN %]│[% RESET %] PORT [% GREEN %]│[% RESET %]' . "\n");
$self->sysop_output('[% GREEN %]├───────────────────────────────────────────────────────────────────┼─...
open(my $FILE, '<', $filename);
chomp(my @bbs = <$FILE>);
close($FILE);
my $sth = $self->{'dbh'}->prepare('REPLACE INTO bbs_listing (bbs_name,bbs_hostname,bbs_port,bbs_poster_id) VALUES (?,?,?,?)');
foreach my $row (@bbs) {
if ($row =~ /^. \S/ && $row !~ /^\* = NEW/) {
$row =~ s/^\* / /;
my ($name, $url) = (substr($row, 2, 41), substr($row, 43));
$name =~ s/(.*?)\s+$/$1/;
my ($address, $port) = split(/:/, $url);
$port = 23 unless (defined($port));
$sth->execute($name, $address, $port, $self->{'USER'}->{'id'});
$self->sysop_output('[% GREEN %]│[% RESET %] ' . sprintf('%-65s', $name) . '[% GREEN %] │[% RESET %] ' . sprintf('%-32s', $address) . ' [% GREEN %]│[% RESET %] ' . sprintf('%5d', $port) . ' [% GREEN %]│[% RESET %]' . "\n");
} ## end if ($row =~ /^. \S/ &&...)
} ## end foreach my $row (@bbs)
$sth->finish();
$self->sysop_output('[% GREEN %]╰───────────────────────────────────────────────────────────────────┴─...
} else {
print "\n", chr(7), colored(['red'], 'Cannot find '), $filename, "\n";
$self->{'debug'}->WARNING(["Cannot find $filename"]);
}
print "\nPress any key to continue";
$self->sysop_get_key(SILENT, BLOCKING);
$self->{'debug'}->DEBUG(['End SysOp BBS List Bulk Import']);
return (TRUE);
} ## 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")));
} else {
print "\n";
}
} ## end while (scalar(@lines))
$self->{'debug'}->DEBUG(['End SysOp ANSI Output']);
return (TRUE);
} ## end sub sysop_ansi_output
sub sysop_output {
my $self = shift;
$| = 1;
$self->{'debug'}->DEBUG(['Start SysOp Output']);
my $text = $self->detokenize_text(shift);
my $response = TRUE;
if (defined($text) && $text ne '') {
while ($text =~ /\[\%\s+WRAP\s+\%\](.*?)\[\%\s+ENDWRAP\s+\%\]/si) {
my $wrapped = $1;
my $format = Text::Format->new(
'columns' => $self->{'USER'}->{'max_columns'} - 1,
'tabstop' => 4,
'extraSpace' => TRUE,
'firstIndent' => 0,
);
$wrapped = $format->format($wrapped);
chomp($wrapped);
$text =~ s/\[\%\s+WRAP\s+\%\].*?\[\%\s+ENDWRAP\s+\%\]/$wrapped/s;
} ## end while ($text =~ /\[\%\s+WRAP\s+\%\](.*?)\[\%\s+ENDWRAP\s+\%\]/si)
while ($text =~ /\[\%\s+JUSTIFIED\s+\%\](.*?)\[\%\s+ENDJUSTIFIED\s+\%\]/si) {
my $wrapped = $1;
my $format = Text::Format->new(
'columns' => $self->{'USER'}->{'max_columns'} - 1,
'tabstop' => 4,
'extraSpace' => TRUE,
'firstIndent' => 0,
'justify' => TRUE,
);
$wrapped = $format->format($wrapped);
chomp($wrapped);
$text =~ s/\[\%\s+JUSTIFIED\s+\%\].*?\[\%\s+ENDJUSTIFIED\s+\%\]/$wrapped/s;
} ## end while ($text =~ /\[\%\s+JUSTIFIED\s+\%\](.*?)\[\%\s+ENDJUSTIFIED\s+\%\]/si)
$self->sysop_ansi_output($text);
} else {
$response = FALSE;
}
$self->{'debug'}->DEBUG(['End SysOp Output']);
return ($response);
} ## end sub sysop_output
1;
( run in 1.895 second using v1.01-cache-2.11-cpan-39bf76dae61 )