BBS-Universal
view release on metacpan or search on metacpan
lib/BBS/Universal.pm view on Meta::CPAN
sub is_connected {
my $self = shift;
if ($self->{'sysop'} || $self->{'local_mode'}) {
return (TRUE);
} elsif ($self->{'CACHE'}->get('RUNNING') && defined($self->{'cl_socket'})) {
$self->{'CACHE'}->set(sprintf('SERVER_%02d', $self->{'thread_number'}), 'CONNECTED');
$self->{'CACHE'}->set('UPDATE', TRUE);
return (TRUE);
} else {
$self->{'debug'}->WARNING(['User disconnected']);
$self->{'CACHE'}->set(sprintf('SERVER_%02d', $self->{'thread_number'}), 'IDLE');
$self->{'CACHE'}->set('UPDATE', TRUE);
return (FALSE);
} ## end else [ if ($self->{'sysop'} ||...)]
} ## end sub is_connected
sub decision {
my $self = shift;
$self->{'debug'}->DEBUG(['Start Decision']);
my $response = uc($self->get_key(SILENT, BLOCKING));
if ($response eq 'Y') {
$self->output("YES\n");
$self->{'debug'}->DEBUG([' Decision YES']);
return (TRUE);
}
$self->{'debug'}->DEBUG([' Decision NO']);
$self->output("NO\n");
$self->{'debug'}->DEBUG(['End Decision']);
return (FALSE);
} ## end sub decision
sub prompt {
my $self = shift;
my $text = shift;
$self->{'debug'}->DEBUG(['Start Prompt', " Prompt > $text"]);
my $response = "\n";
if ($self->{'USER'}->{'text_mode'} eq 'ATASCII') {
$response .= '(' . colored(['bright_yellow'], $self->{'USER'}->{'username'}) . ') ' . $text . chr(31) . ' ';
} elsif ($self->{'USER'}->{'text_mode'} eq 'PETSCII') {
$response .= '(' . $self->{'USER'}->{'username'} . ') ' . "$text > ";
} elsif ($self->{'USER'}->{'text_mode'} eq 'ANSI') {
$response .= '(' . colored(['bright_yellow'], $self->{'USER'}->{'username'}) . ') ' . $text . ' [% BLACK RIGHT-POINTING TRIANGLE %] ';
} else {
$response .= '(' . $self->{'USER'}->{'username'} . ') ' . "$text > ";
}
$self->output($response);
$self->{'debug'}->DEBUG(['End Prompt']);
return (TRUE);
} ## end sub prompt
sub menu_choice {
my $self = shift;
my $choice = shift;
my $color = shift;
my $desc = shift;
$self->{'debug'}->DEBUG(['Start Menu Choice']);
if ($self->{'USER'}->{'text_mode'} eq 'ATASCII') {
$self->output(" $choice " . chr(31) . " $desc");
} elsif ($self->{'USER'}->{'text_mode'} eq 'PETSCII') {
$self->output(" $choice > $desc");
} elsif ($self->{'USER'}->{'text_mode'} eq 'ANSI') {
$self->output(charnames::string_vianame('BOX DRAWINGS LIGHT VERTICAL') . '[% ' . $color . ' %]' . $choice . '[% RESET %]' . charnames::string_vianame('BOX DRAWINGS LIGHT VERTICAL') . '[% ' . $color . ' %]' . charnames::string_vianame('BLACK R...
} else {
$self->output(" $choice > $desc");
}
$self->{'debug'}->DEBUG(['End Menu Choice']);
} ## end sub menu_choice
sub show_choices {
my $self = shift;
my $mapping = shift;
$self->{'debug'}->DEBUG(['Start Show Choices']);
my @list = grep(!/TEXT/, (sort(keys %{$mapping})));
my $twin = FALSE;
$twin = TRUE if (scalar(@list) > 1 && $self->{'USER'}->{'max_columns'} > 40);
my $max = 0;
foreach my $name (@list) {
$max = max(length($mapping->{$name}->{'text'}), $max);
}
if ($self->{'USER'}->{'text_mode'} eq 'ANSI') {
if ($twin) {
$max += 3;
$self->output(sprintf("%s%s%s%-${max}s %s%s%s\t", '[% BOX DRAWINGS LIGHT ARC DOWN AND RIGHT %]', '[% BOX DRAWINGS LIGHT HORIZONTAL %]', '[% BOX DRAWINGS LIGHT ARC DOWN AND LEFT %]', ' ' x $max, '[% BOX DRAWINGS LIGHT ARC DOWN AND RIGHT %]...
} else {
$self->output('[% BOX DRAWINGS LIGHT ARC DOWN AND RIGHT %][% BOX DRAWINGS LIGHT HORIZONTAL %][% BOX DRAWINGS LIGHT ARC DOWN AND LEFT %]' . "\n");
}
} ## end if ($self->{'USER'}->{...})
while (scalar(@list)) {
my $kmenu = shift(@list);
if ($self->{'access_level'}->{ $mapping->{$kmenu}->{'access_level'} } <= $self->{'access_level'}->{ $self->{'USER'}->{'access_level'} }) {
if ($twin) {
$self->menu_choice($kmenu, $mapping->{$kmenu}->{'color'}, $mapping->{$kmenu}->{'text'} . ' ' x (($max - 1) - length($mapping->{$kmenu}->{'text'})));
if (scalar(@list)) {
$kmenu = shift(@list);
$self->menu_choice($kmenu, $mapping->{$kmenu}->{'color'}, $mapping->{$kmenu}->{'text'});
} elsif ($self->{'USER'}->{'text_mode'} eq 'ANSI') {
$self->output(sprintf('%s%s%s', '[% BOX DRAWINGS LIGHT ARC UP AND RIGHT %]', '[% BOX DRAWINGS LIGHT HORIZONTAL %]', '[% BOX DRAWINGS LIGHT ARC UP AND LEFT %]'));
$twin = FALSE;
}
} else {
$self->menu_choice($kmenu, $mapping->{$kmenu}->{'color'}, $mapping->{$kmenu}->{'text'});
}
$self->output("\n");
} ## end if ($self->{'access_level'...})
} ## end while (scalar(@list))
if ($self->{'USER'}->{'text_mode'} eq 'ANSI') {
if ($twin) {
$self->output(sprintf("%s%s%s%-${max}s %s%s%s", '[% BOX DRAWINGS LIGHT ARC UP AND RIGHT %]', '[% BOX DRAWINGS LIGHT HORIZONTAL %]', '[% BOX DRAWINGS LIGHT ARC UP AND LEFT %]', ' ' x $max, '[% BOX DRAWINGS LIGHT ARC UP AND RIGHT %]', '[% B...
} else {
$self->output('[% BOX DRAWINGS LIGHT ARC UP AND RIGHT %][% BOX DRAWINGS LIGHT HORIZONTAL %][% BOX DRAWINGS LIGHT ARC UP AND LEFT %]');
}
} ## end if ($self->{'USER'}->{...})
$self->{'debug'}->DEBUG(['End Show Choices']);
} ## end sub show_choices
sub header {
my $self = shift;
$self->{'debug'}->DEBUG(['Start Header']);
my $width = $self->{'USER'}->{'max_columns'};
my $name = ' ' . $self->{'CONF'}->{'BBS NAME'} . ' ';
my $text = '#' x int(($width - length($name)) / 2);
$text .= $name;
$text .= '#' x ($width - length($text));
if ($self->{'USER'}->{'text_mode'} eq 'ANSI') {
my $char = '[% BOX DRAWINGS HEAVY HORIZONTAL %]';
$text =~ s/\#/$char/g;
}
$self->{'debug'}->DEBUG(['End Header']);
return ($self->detokenize_text('[% CLS %]' . $text));
} ## end sub header
sub load_menu {
my $self = shift;
my $file = shift;
$self->{'debug'}->DEBUG(['Start Load Menu', " Load Menu $file"]);
my $orig = $self->files_load_file($file);
my @Text = split(/\n/, $orig);
my $mapping = { 'TEXT' => '' };
my $mode = TRUE;
my $text = '';
$self->{'debug'}->DEBUG([' Parse Menu']);
foreach my $line (@Text) {
if ($mode) {
next if ($line =~ /^\#/);
if ($line !~ /^---/) {
my ($k, $cmd, $color, $access, $t) = split(/\|/, $line);
$k = uc($k);
$cmd = uc($cmd);
$color = uc($color);
if (exists($self->{'COMMANDS'}->{$cmd})) {
$mapping->{$k} = {
'command' => $cmd,
'color' => $color,
'access_level' => $access,
'text' => $t,
};
} else {
$self->{'debug'}->ERROR(["Command Missing! $cmd"]);
}
} else {
$mode = FALSE;
}
} else {
$mapping->{'TEXT'} .= $self->detokenize_text($line) . "\n";
}
} ## end foreach my $line (@Text)
$mapping->{'TEXT'} = $self->header() . "\n" . $mapping->{'TEXT'};
$self->{'debug'}->DEBUG(['End Load Menu']);
return ($mapping);
} ## end sub load_menu
sub main_menu {
my $self = shift;
my $file = shift;
$self->{'debug'}->DEBUG(['Start Main Menu']);
my $connected = TRUE;
my $command = '';
my $mapping = $self->load_menu($file);
while ($connected && $self->is_connected()) {
$self->output($mapping->{'TEXT'});
$self->show_choices($mapping);
$self->prompt('Choose');
my $key;
do {
$key = uc($self->get_key(SILENT, FALSE));
} until (exists($mapping->{$key}) || $key eq chr(3) || !$self->is_connected());
$self->output($mapping->{$key}->{'command'} . "\n");
if ($key eq chr(3)) {
$command = 'DISCONNECT';
} else {
$command = $mapping->{$key}->{'command'};
}
$mapping = $self->{'COMMANDS'}->{$command}->($self);
if (ref($mapping) ne 'HASH' || !$self->is_connected()) {
$connected = FALSE;
}
} ## end while ($connected && $self...)
$self->{'debug'}->DEBUG(['End Main Menu']);
} ## end sub main_menu
sub disconnect {
my $self = shift;
$self->{'debug'}->DEBUG(['Start Disconnect']);
# Load and print disconnect message here
my $text = $self->files_load_file('files/main/disconnect');
$self->output($text);
my $sth = $self->{'dbh'}->prepare('UPDATE users SET logout_time=NOW() WHERE id=?');
$sth->execute($self->{'USER'}->{'id'});
$sth->finish();
$self->{'debug'}->DEBUG(['End Disconnect']);
return (TRUE);
} ## end sub disconnect
sub parse_telnet_escape {
my $self = shift;
my $command = shift;
my $option = shift;
my $handle = $self->{'cl_socket'};
$self->{'debug'}->DEBUG(['Start Parse Telnet Escape']);
if ($command == WILL) {
if ($option == ECHO) { # WON'T ECHO
print $handle chr(IAC) . chr(WONT) . chr(ECHO);
} elsif ($option == LINEMODE) {
print $handle chr(IAC) . chr(WONT) . chr(LINEMODE);
}
} elsif ($command == DO) {
if ($option == ECHO) { # DON'T ECHO
print $handle chr(IAC) . chr(DONT) . chr(ECHO);
} elsif ($option == LINEMODE) {
print $handle chr(IAC) . chr(DONT) . chr(LINEMODE);
}
} else {
$self->{'debug'}->DEBUG(['Recreived IAC Request - ' . $self->{'telnet_commands'}->[$command - 240] . ' : ' . $self->{'telnet_options'}->[$option]]);
}
$self->{'debug'}->DEBUG(['End Parse Telnet Escape']);
return (TRUE);
} ## end sub parse_telnet_escape
sub flush_input {
my $self = shift;
my $key;
unless ($self->{'sysop'} || $self->{'local_mode'}) {
my $handle = $self->{'cl_socket'};
ReadMode 'noecho', $handle;
do {
$key = ReadKey(-1, $handle);
} until (!defined($key) || $key eq '');
ReadMode 'restore', $handle;
} else {
ReadMode 'ultra-raw';
do {
$key = ReadKey(-1);
} until (!defined($key) || $key eq '');
ReadMode 'restore';
lib/BBS/Universal.pm view on Meta::CPAN
$sth->execute('%' . $filter . '%', '%' . $filter . '%', $self->{'USER'}->{'file_category'});
} else {
$sth = $self->{'dbh'}->prepare('SELECT * FROM files_view WHERE category_id=? ORDER BY uploaded DESC');
$sth->execute($self->{'USER'}->{'file_category'});
}
my @files;
my $max_filename = 10;
my $max_title = 20;
if ($sth->rows > 0) {
while (my $row = $sth->fetchrow_hashref()) {
push(@files, $row);
$max_filename = max(length($row->{'filename'}), $max_filename);
$max_title = max(length($row->{'title'}), $max_title);
}
my $table = Text::SimpleTable->new($max_filename, $max_title);
$table->row('FILENAME', 'TITLE');
$table->hr();
foreach my $record (@files) {
$table->row($record->{'filename'}, $record->{'title'});
}
my $mode = $self->{'USER'}->{'text_mode'};
if ($mode eq 'ANSI') {
my $text = $table->boxes2('MAGENTA')->draw();
while ($text =~ / (FILENAME|TITLE) /s) {
my $ch = $1;
my $new = '[% BRIGHT YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$self->output("\n$text");
} elsif ($mode eq 'ATASCII') {
$self->output("\n" . $self->color_border($table->boxes->draw(), 'MAGENTA'));
} elsif ($mode eq 'PETSCII') {
my $text = $table->boxes->draw();
while ($text =~ / (FILENAME|TITLE) /s) {
my $ch = $1;
my $new = '[% YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$self->output("\n" . $self->color_border($text, 'PURPLE'));
} else {
$self->output("\n" . $table->draw());
}
} elsif ($search) {
$self->output("\nSorry '$filter' not found");
} else {
$self->output("\nSorry, this file category is empty\n");
}
$self->output("\nPress a key to continue ...");
$self->get_key(ECHO, BLOCKING);
$self->{'debug'}->DEBUG(['End Files List Summary']);
return (TRUE);
} ## end sub files_list_summary
sub files_choices {
my ($self, $record) = @_;
while ($self->is_connected()) {
my $view = FALSE;
my $mapping = {
'TEXT' => '',
'Z' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to File Menu' },
'N' => { 'command' => 'NEXT', 'color' => 'BLUE', 'access_level' => 'USER', 'text' => 'Next file' },
'D' => { 'command' => 'DOWNLOAD', 'color' => 'CYAN', 'access_level' => 'VETERAN', 'text' => 'Download file' },
'R' => { 'command' => 'REMOVE FILE', 'color' => 'RED', 'access_level' => 'JUNIOR SYSOP', 'text' => 'Remove file' },
};
if ($record->{'extension'} =~ /^(TXT|ASC|ATA|PET|VT|ANS|MD|INF|CDF|PL|PM|PY|C|CPP|H|SH|CSS|HTM|HTML|SHTML|JS|JAVA|XML|BAT)$/ && $self->check_access_level('VETERAN')) {
$view = TRUE;
$mapping->{'V'} = { 'command' => 'VIEW FILE', 'color' => 'CYAN', 'access_level' => 'VETERAN', 'text' => 'View file' };
} ## end if ($record->{'extension'...})
$self->show_choices($mapping);
$self->prompt('Choose');
my $key;
do {
$key = uc($self->get_key());
} until ($key =~ /D|N|Z/ || ($key eq 'V' && $view) || ($key eq 'R' && $self->check_access_level('JUNION SYSOP')));
$self->output($mapping->{$key}->{'command'} . "\n");
if ($mapping->{$key}->{'command'} eq 'DOWNLOAD') {
my $file = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $record->{'filename'};
$mapping = {
'B' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to File Menu' },
'Y' => { 'command' => 'YMODEM', 'color' => 'YELLOW', 'access_level' => 'VETERAN', 'text' => 'Download with the Ymodem protocol' },
'X' => { 'command' => 'XMODEM', 'color' => 'BRIGHT BLUE', 'access_level' => 'VETERAN', 'text' => 'Download with the Xmodem protocol' },
'Z' => { 'command' => 'ZMODEM', 'color' => 'GREEN', 'access_level' => 'VETERAN', 'text' => 'Download with the Zmodem protocol' },
};
$self->show_choices($mapping);
$self->prompt('Choose');
do {
$key = uc($self->get_key());
} until ($key =~ /B|X|Y|Z/);
$self->output($mapping->{$key}->{'command'});
if ($mapping->{$key}->{'command'} eq 'XMODEM') {
system('sz', '--xmodem', '--quiet', '--binary', $file);
} elsif ($mapping->{$key}->{'command'} eq 'YMODEM') {
system('sz', '--ymodem', '--quiet', '--binary', $file);
} elsif ($mapping->{$key}->{'command'} eq 'ZMODEM') {
system('sz', '--zmodem', '--quiet', '--binary', '--resume', $file);
} else {
return (FALSE);
}
return (TRUE);
} elsif ($mapping->{$key}->{'command'} eq 'VIEW FILE' && $self->check_access_level($mapping->{$key}->{'access_level'})) {
my $file = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $record->{'filename'};
open(my $VIEW, '<', $file);
binmode($VIEW, ":encoding(UTF-8)");
my $data;
read($VIEW, $data, $record->{'file_size'}, 0);
close($VIEW);
$self->output('[% CLS %]' . $data . '[% RESET %]');
} elsif ($mapping->{$key}->{'command'} eq 'REMOVE FILE' && $self->check_access_level($mapping->{$key}->{'access_level'})) {
return (TRUE);
} elsif ($mapping->{$key}->{'command'} eq 'NEXT') {
return (TRUE);
} elsif ($mapping->{$key}->{'command'} eq 'BACK') {
return (FALSE);
}
} ## end while ($self->is_connected...)
} ## end sub files_choices
sub files_upload_choices {
my ($self) = @_;
my $ckey;
$self->prompt('File Name? ');
my $file = $self->get_line({ 'type' => FILENAME, 'max' => 255, 'default' => '' });
my $ext = uc($file =~ /\.(.*?)$/);
$self->prompt('Title (Fiendly name)? ');
my $title = $self->get_line({ 'type' => STRING, 'max' => 255, 'default' => '' });
$self->prompt('Description? ');
my $description = $self->get_line({ 'type' => STRING, 'max' => 255, 'default' => '' });
my $file_category = $self->{'USER'}->{'file_category'};
my $mapping = {
'B' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to File Menu' },
'Y' => { 'command' => 'YMODEM', 'color' => 'YELLOW', 'access_level' => 'VETERAN', 'text' => 'Upload with the Ymodem protocol' },
'X' => { 'command' => 'XMODEM', 'color' => 'BRIGHT BLUE', 'access_level' => 'VETERAN', 'text' => 'Upload with the Xmodem protocol' },
'Z' => { 'command' => 'ZMODEM', 'color' => 'GREEN', 'access_level' => 'VETERAN', 'text' => 'Upload with the Zmodem protocol' },
};
$self->show_choices($mapping);
$self->prompt('Choose');
do {
$ckey = uc($self->get_key());
} until ($ckey =~ /B|X|Y|Z/);
$self->output($mapping->{$ckey}->{'command'});
if ($mapping->{$ckey}->{'command'} eq 'XMODEM') {
if ($self->files_receive_file($file, XMODEM)) {
my $filename = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file;
my $size = (-s $filename);
my $sth = $self->{'dbh'}->prepare('INSERT INTO files (category,filename,title,file_type,description,file_size) VALUES (?,?,?,(SELECT id FROM file_types WHERE extension=?),?,?');
$sth->execute($file_category, $file, $title, $ext, $description, $size);
$sth->finish();
} ## end if ($self->files_receive_file...)
} elsif ($mapping->{$ckey}->{'command'} eq 'YMODEM') {
if ($self->files_receive_file($file, YMODEM)) {
my $filename = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file;
my $size = (-s $filename);
my $sth = $self->{'dbh'}->prepare('INSERT INTO files (category,filename,title,file_type,description,file_size) VALUES (?,?,?,(SELECT id FROM file_types WHERE extension=?),?,?');
$sth->execute($file_category, $file, $title, $ext, $description, $size);
$sth->finish();
} ## end if ($self->files_receive_file...)
} elsif ($mapping->{$ckey}->{'command'} eq 'ZMODEM') {
if ($self->files_receive_file($file, ZMODEM)) {
my $filename = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file;
my $size = (-s $filename);
my $sth = $self->{'dbh'}->prepare('INSERT INTO files (category,filename,title,file_type,description,file_size) VALUES (?,?,?,(SELECT id FROM file_types WHERE extension=?),?,?');
$sth->execute($file_category, $file, $title, $ext, $description, $size);
$sth->finish();
} ## end if ($self->files_receive_file...)
} else {
return (FALSE);
}
if ($? == -1) {
$self->{'debug'}->ERROR(["Could not execute rz: $!"]);
} elsif ($? & 127) {
$self->{'debug'}->ERROR(["File Transfer Aborted: $!"]);
} else {
$self->{'debug'}->DEBUG(['File Transfer Successful']);
}
return (TRUE);
} ## end sub files_upload_choices
sub files_list_detailed {
my ($self, $search) = @_;
$self->{'debug'}->DEBUG(['Start Files List Detailed']);
my $sth;
my $filter;
my $columns = $self->{'USER'}->{'max_columns'};
if ($search) {
$self->prompt('Search for');
$filter = $self->get_line({ 'type' => STRING, 'max' => 255, 'default' => '' });
$sth = $self->{'dbh'}->prepare('SELECT * FROM files_view WHERE (filename LIKE ? OR title LIKE ?) AND category_id=? ORDER BY uploaded DESC');
$sth->execute('%' . $filter . '%', '%' . $filter . '%', $self->{'USER'}->{'file_category'});
} else {
lib/BBS/Universal.pm view on Meta::CPAN
} ## end sub files_send_zmodem
sub files_receive_file_zmodem {
my ($self, $file) = @_;
$self->{'debug'}->DEBUG(['Start files_receive_file_zmodem (using lrzsz)']);
my $sock = $self->{'cl_socket'};
unless ($sock) {
$self->{'debug'}->ERROR(["No client socket for ZMODEM receive"]);
return 0;
}
$self->output("\nStart Zmodem file upload\n");
# When rz receives files it writes them into the current working directory.
# Use the destination directory from config (same place other uploads are stored).
my $dest_dir = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'};
# ensure directory exists
unless (-d $dest_dir) {
File::Path::mkpath($dest_dir);
if ($@) {
$self->{'debug'}->ERROR(["Failed to create dest dir $dest_dir: $@"]);
return 0;
}
} ## end unless (-d $dest_dir)
# We will chdir in the child before exec so the received file lands in $dest_dir.
# Use rz --binary --quiet. Depending on lrzsz version you may want --overwrite or --keep
my @args = ('--binary', '--overwrite', '--quiet');
my $ok = $self->_run_on_socket('rz', \@args, $dest_dir);
$self->output("\nFile upload complete\n");
$self->{'debug'}->DEBUG(['End files_receive_file_zmodem (using lrzsz)']);
return $ok;
} ## end sub files_receive_file_zmodem
# package BBS::Universal::Messages;
sub messages_initialize {
my $self = shift;
$self->{'debug'}->DEBUG(['Start Messages Initialize']);
$self->{'debug'}->DEBUG(['End Messages Initialize']);
return ($self);
} ## end sub messages_initialize
sub messages_forum_categories {
my $self = shift;
$self->{'debug'}->DEBUG(['Start Messages Forum Categories']);
my $command = '';
my $id;
my $sth = $self->{'dbh'}->prepare('SELECT * FROM message_categories ORDER BY description');
my $category = $self->{'USER'}->{'forum_category'};
$sth->execute(); # $self->{'USER'}->{'forum_category'});
my $mapping = {
'TEXT' => '',
'Z' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to Forum Menu' },
};
my @menu_choices = @{ $self->{'MENU CHOICES'} };
while (my $result = $sth->fetchrow_hashref()) {
if ($self->check_access_level($result->{'access_level'})) {
$mapping->{ shift(@menu_choices) } = {
'command' => $result->{'name'},
'id' => $result->{'id'},
'color' => ($category == $result->{'id'}) ? 'GREEN' : 'WHITE',
'access_level' => $result->{'access_level'},
'text' => $result->{'description'},
};
} ## end if ($self->check_access_level...)
} ## end while (my $result = $sth->...)
$sth->finish();
$self->show_choices($mapping);
$self->prompt('Choose Forum Category');
my $key;
do {
$key = uc($self->get_key(SILENT, BLOCKING));
} until (exists($mapping->{$key}) || $key eq chr(3) || !$self->is_connected());
if ($key eq chr(3)) {
$command = 'DISCONNECT';
} else {
$id = $mapping->{$key}->{'id'};
$command = $mapping->{$key}->{'command'};
}
return ($command) if ($key eq 'Z');
if ($self->is_connected() && $command ne 'DISCONNECT') {
$self->output($command);
$sth = $self->{'dbh'}->prepare('UPDATE users SET forum_category=? WHERE id=?');
$sth->execute($id, $self->{'USER'}->{'id'});
$sth->finish();
$self->{'USER'}->{'forum_category'} = $id;
$command = 'BACK';
} ## end if ($self->is_connected...)
$self->{'debug'}->DEBUG(['End Messages Forum Categories']);
return ($command);
} ## end sub messages_forum_categories
sub messages_list_messages {
my $self = shift;
$self->{'debug'}->DEBUG(['Start Messages List Messages']);
my $id;
my $command;
my $forum_category = $self->{'USER'}->{'forum_category'};
my $sth = $self->{'dbh'}->prepare('SELECT id,from_id,category,author_fullname,author_nickname,author_username,title,created FROM messages_view WHERE category=? ORDER BY created DESC');
my @index;
$sth->execute($forum_category);
if ($sth->rows()) {
while (my $record = $sth->fetchrow_hashref) {
push(@index, $record);
}
$sth->finish();
my $result;
my $count = 0;
do {
$result = $index[$count];
$sth = $self->{'dbh'}->prepare('SELECT message FROM messages_view WHERE id=? ORDER BY created DESC');
$sth->execute($result->{'id'});
$result->{'message'} = $sth->fetchrow_array();
$sth->finish();
my $mode = $self->{'USER'}->{'text_mode'};
if ($mode eq 'ANSI') {
$self->output("[% CLS %][% HORIZONTAL RULE MAGENTA %][% B_MAGENTA %][% BLACK %]" . $self->pad_center('FORUM MESSAGE' . $self->{'USER'}->{'max_columns'}) . "[% RESET %]\n");
$self->output('[% B_BRIGHT GREEN %][% BLACK %] CATEGORY [% RESET %] [% BOLD %][% GREEN %][% FORUM CATEGORY %][% RESET %]' . "\n");
$self->output('[% BRIGHT WHITE %][% B_BLUE %] Author [% RESET %] ');
$self->output(($result->{'prefer_nickname'}) ? $result->{'author_nickname'} : $result->{'author_fullname'});
$self->output(' (' . $result->{'author_username'} . ')' . "\n");
$self->output('[% BRIGHT WHITE %][% B_BLUE %] Title [% RESET %] ' . $result->{'title'} . "\n");
$self->output('[% BRIGHT WHITE %][% B_BLUE %] Created [% RESET %] ' . $self->users_get_date($result->{'created'}) . "\n\n");
$self->output($result->{'message'}) if ($self->{'USER'}->{'read_message'});
$self->output("\n[% HORIZONTAL RULE MAGENTA %]\n");
} elsif ($mode eq 'PETSCII') {
$self->output("[% CLS %][% GREEN %]== FORUM " . '=' x ($self->{'USER'}->{'max_columns'} - 7) . "[% RESET %]\n");
$self->output('[% GREEN %] CATEGORY [% RESET %] [% FORUM CATEGORY %]' . "\n");
$self->output('[% YELLOW %] Author [% RESET %] ');
$self->output(($result->{'prefer_nickname'}) ? $result->{'author_nickname'} : $result->{'author_fullname'});
$self->output(' (' . $result->{'author_username'} . ')' . "\n");
$self->output('[% YELLOW %] Title [% RESET %] ' . $result->{'title'} . "\n");
$self->output('[% YELLOW %] Created [% RESET %] ' . $self->users_get_date($result->{'created'}) . "\n\n");
$self->output($result->{'message'}) if ($self->{'USER'}->{'read_message'});
$self->output("\n[% GREEN %]" . '=' x $self->{'USER'}->{'max_columns'} . "[% RESET %]\n");
} else {
$self->output("[% CLS %]== FORUM " . '=' x ($self->{'USER'}->{'max_columns'} - 7) . "\n");
$self->output(' CATEGORY > [% FORUM CATEGORY %]' . "\n");
$self->output(' Author: ');
$self->output(($result->{'prefer_nickname'}) ? $result->{'nickname'} : $result->{'author_fullname'});
$self->output(' (' . $result->{'author_username'} . ')' . "\n");
$self->output(' Title: ' . $result->{'title'} . "\n");
$self->output(' Created: ' . $self->users_get_date($result->{'created'}) . "\n\n");
$self->output($result->{'message'}) if ($self->{'USER'}->{'read_message'});
$self->output("\n" . '=' x $self->{'USER'}->{'max_columns'} . "\n");
} ## end else [ if ($mode eq 'ANSI') ]
my $mapping = {
'Z' => { 'id' => $result->{'id'}, 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to the Forum Menu' },
'N' => { 'id' => $result->{'id'}, 'command' => 'NEXT', 'color' => 'BRIGHT BLUE', 'access_level' => 'USER', 'text' => 'Next Message' },
};
if ($self->{'USER'}->{'post_message'}) {
$mapping->{'R'} = { 'id' => $result->{'id'}, 'command' => 'REPLY', 'color' => 'BRIGHT GREEN', 'access_level' => 'USER', 'text' => 'Reply' };
} ## end if ($self->{'USER'}->{...})
if ($self->{'USER'}->{'remove_message'}) {
$mapping->{'D'} = { 'id' => $result->{'id'}, 'command' => 'DELETE', 'color' => 'RED', 'access_level' => 'JUNIOR SYSOP', 'text' => 'Delete Message' };
} ## end if ($self->{'USER'}->{...})
$self->show_choices($mapping);
$self->prompt('Choose');
my $key;
do {
$key = uc($self->get_key(SILENT, FALSE));
} until (exists($mapping->{$key}) || $key eq chr(3) || !$self->is_connected());
if ($key eq chr(3)) {
$id = undef;
$command = 'DISCONNECT';
} else {
$id = $mapping->{$key}->{'id'};
$command = $mapping->{$key}->{'command'};
}
$self->output($command);
if ($command eq 'REPLY') {
my $message = $self->messages_edit_message('REPLY', $result);
push(@index, $message);
$count = 0;
} elsif ($command eq 'DELETE') {
$self->messages_delete_message($result);
delete($index[$count]);
} else {
$count++;
}
unless ($self->{'local_mode'} || $self->{'sysop'} || $self->is_connected()) {
$command = 'DISCONNECT';
}
} until ($count >= scalar(@index) || $command =~ /^(DISCONNECT|BACK)$/);
} else {
$self->output("\nNo messages\n\nPress any key\n");
$self->get_key(SILENT, BLOCKING);
} # end if ($sth->rows())
$self->{'debug'}->DEBUG(['End Messages List Messages']);
return (TRUE);
} ## end sub messages_list_messages
sub messages_edit_message {
my $self = shift;
my $mode = shift;
my $old_message = (scalar(@_)) ? shift : undef;
$self->{'debug'}->DEBUG(['Start Messages Edit Message']);
my $message;
if ($mode eq 'ADD') {
$self->{'debug'}->DEBUG([' Add Message']);
$self->output("Add New Message\n");
$message = $self->messages_text_editor();
if (defined($message)) {
$message->{'from_id'} = $self->{'USER'}->{'id'};
$message->{'category'} = $self->{'USER'}->{'forum_category'};
my $sth = $self->{'dbh'}->prepare('INSERT INTO messages (category, from_id, title, message) VALUES (?, ?, ?, ?)');
$sth->execute($message->{'category'}, $message->{'from_id'}, $message->{'title'}, $message->{'message'});
lib/BBS/Universal.pm view on Meta::CPAN
my $sql = q{
SELECT news_id,
news_title,
news_content,
DATE_FORMAT(news_date,?) AS newsdate
FROM news
ORDER BY news_date DESC};
my $sth = $self->{'dbh'}->prepare($sql);
$sth->execute($format);
if ($sth->rows > 0) {
my $table = Text::SimpleTable->new(10, $self->{'USER'}->{'max_columns'} - 14);
$table->row('DATE', 'TITLE');
$table->hr();
while (my $row = $sth->fetchrow_hashref()) {
$table->row($row->{'newsdate'}, $row->{'news_title'});
}
my $mode = $self->{'USER'}->{'text_mode'};
if ($mode eq 'ANSI') {
my $text = $table->boxes2('BRIGHT BLUE')->draw();
my $ch = colored(['bright_yellow'], 'DATE');
$text =~ s/DATE/$ch/;
$ch = colored(['bright_yellow'], 'TITLE');
$text =~ s/TITLE/$ch/;
$self->output($text);
} elsif ($mode eq 'ATASCII') {
my $text = $self->color_border($table->boxes->draw(), 'BLUE');
$self->output($text);
} elsif ($mode eq 'PETSCII') {
my $text = $table->boxes->draw();
while ($text =~ / (DATE|TITLE) /s) {
my $ch = $1;
my $new = '[% YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$text = $self->color_border($text, 'LIGHT BLUE');
$self->output($text);
} else {
$self->output($table->draw());
}
} else {
$self->output('No News');
}
$sth->finish();
$self->output("\nPress a key to continue ... ");
$self->get_key(SILENT, BLOCKING);
$self->{'debug'}->DEBUG(['End News Summary']);
return (TRUE);
} ## end sub news_summary
sub news_rss_categories {
my $self = shift;
$self->{'debug'}->DEBUG(['Start News RSS Categories']);
my $command = '';
my $id;
my $sth = $self->{'dbh'}->prepare('SELECT * FROM rss_feed_categories WHERE id<>? ORDER BY description');
$sth->execute($self->{'USER'}->{'rss_category'});
my $mapping = {
'TEXT' => '',
'Z' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to News Menu' },
};
my @menu_choices = @{$self->{'MENU CHOICES'}};
while (my $result = $sth->fetchrow_hashref()) {
if ($self->check_access_level($result->{'access_level'})) {
$mapping->{ shift(@menu_choices) } = {
'command' => $result->{'title'},
'id' => $result->{'id'},
'color' => 'WHITE',
'access_level' => $result->{'access_level'},
'text' => $result->{'description'},
};
} ## end if ($self->check_access_level...)
} ## end while (my $result = $sth->...)
$sth->finish();
$self->show_choices($mapping);
$self->prompt('Choose World News Feed Category');
my $key;
do {
$key = uc($self->get_key(SILENT, BLOCKING));
} until (exists($mapping->{$key}) || $key eq chr(3) || !$self->is_connected());
if ($key eq chr(3)) {
return ('DISCONNECT');
} else {
$id = $mapping->{$key}->{'id'};
$command = $mapping->{$key}->{'command'};
}
if ($self->is_connected() && $command ne 'BACK') {
$self->output($command);
$sth = $self->{'dbh'}->prepare('UPDATE users SET rss_category=? WHERE id=?');
$sth->execute($id, $self->{'USER'}->{'id'});
if ($sth->err) {
$self->{'debug'}->ERROR([$sth->errstr]);
}
$sth->finish();
$self->{'USER'}->{'rss_category'} = $id;
$command = 'BACK';
} ## end if ($self->is_connected...)
$self->{'debug'}->DEBUG(['End News RSS Categories']);
return ($command);
} ## end sub news_rss_categories
sub news_rss_feeds {
my $self = shift;
$self->{'debug'}->DEBUG(['Start News RSS Feeds']);
my $mode = $self->{'USER'}->{'text_mode'};
my $sth = $self->{'dbh'}->prepare('SELECT * FROM rss_view WHERE category=? ORDER BY title');
$sth->execute($self->{'USER'}->{'rss_category'});
my $mapping = {
'TEXT' => '',
'Z' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to News Menu' },
};
my @menu_choices = @{$self->{'MENU CHOICES'}};
while (my $result = $sth->fetchrow_hashref()) {
if ($self->check_access_level($result->{'access_level'})) {
$mapping->{ shift(@menu_choices) } = {
'command' => $result->{'title'},
'id' => $result->{'id'},
'color' => 'WHITE',
'access_level' => $result->{'access_level'},
'text' => $result->{'title'},
'url' => $result->{'url'},
};
} ## end if ($self->check_access_level...)
} ## end while (my $result = $sth->...)
$sth->finish();
$self->show_choices($mapping);
$self->prompt('Choose World News Feed');
my $id;
my $key;
my $command;
my $url;
my $text;
do {
$key = uc($self->get_key(SILENT, BLOCKING));
} until (exists($mapping->{$key}) || $key eq chr(3) || !$self->is_connected());
if ($key eq chr(3)) {
$command = 'DISCONNECT';
} else {
$id = $mapping->{$key}->{'id'};
$command = $mapping->{$key}->{'command'};
$url = $mapping->{$key}->{'url'};
$text = $mapping->{$key}->{'text'};
} ## end else [ if ($key eq chr(3)) ]
if ($self->is_connected() && $command ne 'DISCONNECT' && $command ne 'BACK') {
$self->output($self->news_title_colorize($text));
my $rss_string = `curl -s $url`;
my $rss;
my $list;
eval {
$rss = XML::RSS::LibXML->new;
$rss->parse($rss_string);
$list = $rss->items;
};
if ($@) {
$self->{'debug'}->ERROR([$@]);
$self->output("ERROR > $@");
} else {
my $text;
foreach my $item (@{$list}) {
last unless ($self->is_connected());
if ($mode eq 'ANSI') {
$text .= '[% NAVY %]' . 'â”' x $self->{'USER'}->{'max_columns'} . "[% RESET %]\n";
$text .= '[% BRIGHT WHITE %][% B_TEAL %] Title [% RESET %] [% GREEN %]' . $self->html_to_text($item->{'title'}) . "[% RESET %]\n";
$text .= '[% BRIGHT WHITE %][% B_TEAL %] Description [% RESET %] ' . $self->html_to_text($item->{'description'}) . "\n";
$text .= '[% BRIGHT WHITE %][% B_TEAL %] Link [% RESET %] [% YELLOW %]' . $item->{'link'} . "[% RESET %]\n";
} elsif ($mode eq 'PETSCII') {
$text .= '[% YELLOW %] Title [% RESET %] [% GREEN %]' . $self->html_to_text($item->{'title'}) . "\n";
$text .= '[% YELLOW %] Description [% RESET %] ' . $self->html_to_text($item->{'description'}) . "\n";
$text .= '[% YELLOW %] Link [% RESET %] [% YELLOW %]' . $item->{'link'} . "[% RESET %]\n";
lib/BBS/Universal.pm view on Meta::CPAN
my $heading = ''; # = "\t";
my $counter = $sections;
for (my $count = $sections - 1; $count > 0; $count--) {
$heading .= ' NAME VERSION ';
if ($count) {
$heading .= "\t";
} else {
$heading .= "\n";
}
} ## end for (my $count = $sections...)
$heading = '[% BRIGHT YELLOW %][% B_RED %]' . $heading . '[% RESET %]';
foreach my $v (sort(keys %{ $self->{'VERSIONS'} })) {
next if ($bbs_only && $v !~ /^BBS/);
$versions .= sprintf(' %-28s %.03f', $v, $self->{'VERSIONS'}->{$v});
$counter--;
if ($counter <= 1) {
$counter = $sections;
$versions .= "\n";
} else {
$versions .= "\t";
}
} ## end foreach my $v (sort(keys %{...}))
chop($versions) if (substr($versions, -1, 1) eq "\t");
$self->{'debug'}->DEBUG(['End SysOp Versions Format']);
return ($heading . $versions . "\n");
} ## end sub sysop_versions_format
sub sysop_disk_free { # Show the Disk Free portion of Statistics
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Disk Free']);
my $diskfree = '';
if ((-e '/usr/bin/duf' || -e '/usr/local/bin/duf') && $self->configuration('USE DUF') =~ /^(TRUE|YES|OM)$/) {
my ($wsize, $hsize, $wpixels, $hpixels) = GetTerminalSize();
$diskfree = `duf -theme ansi -width $wsize`;
} else {
my @free = split(/\n/, `nice df -h -T`); # Get human readable disk free showing type
my $width = 1;
foreach my $l (@free) {
$width = max(length($l), $width); # find the width of the widest line
}
foreach my $line (@free) {
next if ($line =~ /tmp|boot/);
if ($line =~ /^Filesystem/) {
$diskfree .= '[% B_BLUE %][% BRIGHT YELLOW %]' . " $line " . ' ' x ($width - length($line)) . "[% RESET %]\n"; # Make the heading the right width
} else {
$diskfree .= " $line\n";
}
} ## end foreach my $line (@free)
} ## end else [ if ((-e '/usr/bin/duf'...))]
$self->{'debug'}->DEBUG(['End SysOp Disk Free']);
return ($diskfree);
} ## end sub sysop_disk_free
sub sysop_load_menu {
my $self = shift;
my $row = shift;
my $file = shift;
$self->{'debug'}->DEBUG(['Start SysOp Load Menu', " SysOp Load Menu $file"]);
my $mapping = { 'TEXT' => '' };
my $mode = 1;
my $text = locate($row, 1) . cldown;
open(my $FILE, '<', $file);
shift(@{ $self->{'sysop_menu_files'} });
push(@{ $self->{'sysop_menu_files'} }, $file);
for (my $count = 0; $count < 5; $count++) {
if ($count == 4) {
print locate(($count + 1), 108), colored(['green', 'on_black'], clline . $self->{'sysop_menu_files'}->[$count]);
} else {
print locate(($count + 1), 108), colored(['ansi22', 'on_black'], clline . $self->{'sysop_menu_files'}->[$count]);
}
} ## end for (my $count = 0; $count...)
while (chomp(my $line = <$FILE>)) {
next if ($line =~ /^\#/);
if ($mode) {
if ($line !~ /^---/) {
my ($k, $cmd, $color, $t) = split(/\|/, $line);
$k = uc($k);
$cmd = uc($cmd);
$self->{'debug'}->DEBUGMAX([$k, $cmd, $color, $t]);
$mapping->{$k} = {
'command' => $cmd,
'color' => $color,
'text' => $t,
};
} else {
$mode = 0;
}
} else {
$mapping->{'TEXT'} .= $self->sysop_detokenize($line) . "\n";
}
} ## end while (chomp(my $line = <$FILE>...))
close($FILE);
$self->{'debug'}->DEBUG(['End SysOp Load Menu']);
return ($mapping);
} ## end sub sysop_load_menu
sub sysop_pager {
my $self = shift;
my $text = shift;
my $offset = (scalar(@_)) ? shift : 0;
$self->{'debug'}->DEBUG(['Start SysOp Pager']);
my ($wsize, $hsize, $wpixels, $hpixels) = GetTerminalSize();
my @lines;
@lines = split(/\n$/, $text);
my $size = ($hsize - ($self->{'CACHE'}->get('START_ROW') + $self->{'CACHE'}->get('ROW_ADJUST')));
$size -= $offset;
my $scroll = TRUE;
my $count = 1;
while (scalar(@lines)) {
my $line = shift(@lines);
$self->sysop_output("$line\n");
# $self->sysop_ansi_output("$line\n");
$count++;
if ($count >= $size) {
$count = 1;
$scroll = $self->sysop_scroll();
last unless ($scroll);
}
} ## end while (scalar(@lines))
$self->{'debug'}->DEBUG(['End SysOp Pager']);
return ($scroll);
} ## end sub sysop_pager
sub sysop_parse_menu {
my $self = shift;
my $row = shift;
my $file = shift;
my $row = $self->{'CACHE'}->get('START_ROW') + $self->{'CACHE'}->get('ROW_ADJUST');
my $animate = ($self->{'CONF'}->{'SYSOP ANIMATED MENU'}) ? TRUE : FALSE;
$self->{'debug'}->DEBUG(['Start SysOp Parse Menu', " SysOp Parse Menu $file"]);
my $mapping = $self->sysop_load_menu($row, $file);
print locate($row, 1), cldown;
my $scroll = $self->sysop_pager($mapping->{'TEXT'}, 3);
my $keys = '';
print "\r", cldown unless ($scroll);
$self->sysop_show_choices($mapping);
$self->sysop_prompt('Choose');
my $key;
do {
$key = uc($self->sysop_keypress($row, $animate));
threads->yield();
} until (exists($mapping->{$key}));
print $mapping->{$key}->{'command'}, "\n";
$self->{'debug'}->DEBUG(['End SysOp Parse Menu']);
return ($mapping->{$key}->{'command'});
} ## end sub sysop_parse_menu
sub sysop_decision {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Decision']);
my $response;
do {
$response = uc($self->sysop_keypress());
} until ($response =~ /Y|N/i || $response eq chr(13));
if ($response eq 'Y') {
print "YES\n";
$self->{'debug'}->DEBUG([' SysOp Decision YES']);
$self->{'debug'}->DEBUG(['End SysOp Decision']);
return (TRUE);
} ## end if ($response eq 'Y')
$self->{'debug'}->DEBUG([' SysOp Decision NO']);
print "NO\n";
$self->{'debug'}->DEBUG(['End SysOp Decision']);
return (FALSE);
} ## end sub sysop_decision
sub sysop_keypress {
my $self = shift;
my $row;
my $animate = FALSE;
if (scalar(@_)) {
$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
lib/BBS/Universal.pm view on Meta::CPAN
} elsif ($conf eq 'DEFAULT TEXT MODE') {
$c .= ' - ANSI, ASCII, ATASCII, PETSCII';
}
if ($view) {
$table->row($conf, $c);
} else {
if ($conf =~ /AUTHOR/) {
$table->row(' ', $conf, $c);
} else {
$table->row($choice, $conf, $c);
$count++;
}
} ## end else [ if ($view) ]
} ## end foreach my $conf (sort(keys...))
my $output = $table->thick('RED')->draw();
foreach my $change ('AUTHOR EMAIL', 'AUTHOR LOCATION', 'AUTHOR NAME', 'DATABASE USERNAME', 'DATABASE NAME', 'DATABASE PORT', 'DATABASE TYPE', 'DATBASE USERNAME', 'DATABASE HOSTNAME', '300, 600, 1200, 2400, 4800, 9600, 19200, FULL', '%d = day, %m ...
if ($output =~ /$change/) {
my $ch;
if (/^(AUTHOR|DATABASE)/) {
$ch = '[% YELLOW %]' . $change . '[% RESET %]';
} else {
$ch = '[% GRAY 11 %]' . $change . '[% RESET %]';
}
$output =~ s/$change/$ch/gs;
} ## end if ($output =~ /$change/)
} ## end foreach my $change ('AUTHOR EMAIL'...)
{
my $ch = colored(['cyan'], 'CHOICE');
$output =~ s/CHOICE/$ch/gs;
$ch = colored(['bright_yellow'], 'STATIC NAME');
$output =~ s/STATIC NAME/$ch/gs;
$ch = colored(['bright_yellow'], 'STATIC VALUE');
$output =~ s/STATIC VALUE/$ch/gs;
$ch = colored(['green'], 'CONFIG NAME');
$output =~ s/CONFIG NAME/$ch/gs;
$ch = colored(['cyan'], 'CONFIG VALUE');
$output =~ s/CONFIG VALUE/$ch/gs;
$ch = colored(['green'], 'TRUE');
$output =~ s/TRUE/$ch/gs;
$ch = colored(['red'], 'FALSE');
$output =~ s/FALSE/$ch/gs;
$ch = colored(['green'], 'ON');
$output =~ s/ ON / $ch /gs;
$ch = colored(['red'], 'OFF');
$output =~ s/ OFF / $ch /gs;
$ch = colored(['green'], 'YES');
$output =~ s/YES/$ch/gs;
$ch = colored(['red'], 'NO');
$output =~ s/ NO / $ch /gs;
}
my $response;
if ("$view" eq 'string') {
$response = $output;
} elsif ($view == TRUE) {
print $self->sysop_detokenize($output);
print 'Press a key to continue ... ';
$response = $self->sysop_keypress();
} elsif ($view == FALSE) {
print $self->sysop_detokenize($output);
print $self->sysop_menu_choice('TOP', '', '');
print $self->sysop_menu_choice('Z', 'RED', 'Return to Settings Menu');
print $self->sysop_menu_choice('BOTTOM', '', '');
$self->sysop_prompt('Choose');
$response = TRUE;
} ## end elsif ($view == FALSE)
$self->{'debug'}->DEBUG(['End SysOp View Configuration']);
return ($response);
} ## end sub sysop_view_configuration
sub sysop_edit_configuration {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp Edit Configuration']);
$self->sysop_view_configuration(FALSE);
my $types = {
'BBS NAME' => { 'max' => 50, 'type' => STRING, },
'BBS ROOT' => { 'max' => 60, 'type' => STRING, },
'HOST' => { 'max' => 20, 'type' => HOST, },
'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
lib/BBS/Universal.pm view on Meta::CPAN
} elsif ($name eq 'text_mode' && $val !~ /^(ASCII|ATASCII|PETSCII|ANSI)$/) {
print locate($row, ($column + $size)), colored(['red'], ' Only ASCII,ATASCII,PETSCII,ANSI'), locate($row, $column);
$response = FALSE;
} elsif ($name =~ /(prefer_nickname|_files|_message|sysop)/ && $val !~ /^(yes|no|true|false|on|off|0|1)$/i) {
print locate($row, ($column + $size)), colored(['red'], ' Only Yes/No or On/Off or 1/0'), locate($row, $column);
$response = FALSE;
} elsif ($name eq 'birthday' && $val ne '' && $val !~ /(\d\d\d\d)-(\d\d)-(\d\d)/) {
print locate($row, ($column + $size)), colored(['red'], ' YEAR-MM-DD'), locate($row, $column);
$self->{'debug'}->DEBUG(['sysop_validate_fields end']);
$response = FALSE;
}
$self->{'debug'}->DEBUG(['Start SysOp Validate Fields']);
return ($response);
} ## end sub sysop_validate_fields
sub sysop_prompt {
my $self = shift;
my $text = shift;
$self->{'debug'}->DEBUG(['Start SysOp Prompt']);
my $response = "\n" . '[% B_BRIGHT MAGENTA %][% BLACK %] SYSOP TOOL [% RESET %] ' . $text . ' [% PINK %][% BLACK RIGHTWARDS ARROWHEAD %][% RESET %] ';
print $self->sysop_detokenize($response);
$self->{'debug'}->DEBUG(['End SysOp Prompt']);
return (TRUE);
} ## end sub sysop_prompt
sub sysop_detokenize {
my $self = shift;
my $text = shift;
# OPERATION TOKENS
foreach my $key (keys %{ $self->{'sysop_tokens'} }) {
my $ch = '';
if ($key eq 'MIDDLE VERTICAL RULE color' && $text =~ /\[\%\s+MIDDLE VERTICAL RULE (.*?)\s+\%\]/) {
my $color = $1;
if (ref($self->{'sysop_tokens'}->{$key}) eq 'CODE') {
$ch = $self->{'sysop_tokens'}->{$key}->($self, $color);
}
$text =~ s/\[\%\s+MIDDLE VERTICAL RULE (.*?)\s+\%\]/$ch/gi;
} elsif ($text =~ /\[\%\s+$key\s+\%\]/) {
if (ref($self->{'sysop_tokens'}->{$key}) eq 'CODE') {
$ch = $self->{'sysop_tokens'}->{$key}->($self);
} else {
$ch = $self->{'sysop_tokens'}->{$key};
}
$text =~ s/\[\%\s+$key\s+\%\]/$ch/gi;
} ## end elsif ($text =~ /\[\%\s+$key\s+\%\]/)
} ## end foreach my $key (keys %{ $self...})
$text = $self->ansi_decode($text);
return ($text);
} ## end sub sysop_detokenize
sub sysop_menu_choice {
my $self = shift;
my $choice = shift;
my $color = shift;
my $desc = shift;
$self->{'debug'}->DEBUG(['Start SysOp Menu Choice']);
my $response;
if ($choice eq 'TOP') {
$response = charnames::string_vianame('BOX DRAWINGS LIGHT ARC DOWN AND RIGHT') . charnames::string_vianame('BOX DRAWINGS LIGHT HORIZONTAL') . charnames::string_vianame('BOX DRAWINGS LIGHT ARC DOWN AND LEFT') . "\n";
} elsif ($choice eq 'BOTTOM') {
$response = $self->news_title_colorize(charnames::string_vianame('BOX DRAWINGS LIGHT ARC UP AND RIGHT') . charnames::string_vianame('BOX DRAWINGS LIGHT HORIZONTAL') . charnames::string_vianame('BOX DRAWINGS LIGHT ARC UP AND LEFT')) . "\n";
} else {
$response = $self->ansi_decode(charnames::string_vianame('BOX DRAWINGS LIGHT VERTICAL') . '[% BOLD %][% ' . $color . ' %]' . $choice . '[% RESET %]' . charnames::string_vianame('BOX DRAWINGS LIGHT VERTICAL') . ' [% ' . $color . ' %]' . charna...
}
$self->{'debug'}->DEBUG(['End SysOp Menu Choice']);
return ($response);
} ## end sub sysop_menu_choice
sub sysop_showenv {
my $self = shift;
$self->{'debug'}->DEBUG(['Start SysOp ShowENV']);
my $MAX = 0;
my $text = '';
foreach my $e (keys %ENV) {
$MAX = max(length($e), $MAX);
}
foreach my $env (sort(keys %ENV)) {
if ($ENV{$env} =~ /\n/g || $env eq 'WHATISMYIP_INFO') {
my @in = split(/\n/, $ENV{$env});
my $indent = $MAX + 4;
$text .= '[% BRIGHT WHITE %]' . sprintf("%${MAX}s", $env) . "[% RESET %] = ---\n";
foreach my $line (@in) {
if ($line =~ /\:/) {
my ($f, $l) = $line =~ /^(.*?):(.*)/;
chomp($l);
chomp($f);
$f = uc($f);
if ($f eq 'IP') {
$l = colored(['bright_green'], $l);
$f = 'IP ADDRESS';
}
my $le = 11 - length($f);
$f .= ' ' x $le;
$l = colored(['green'], uc($l)) if ($l =~ /^ok/i);
$l = colored(['bold red'], 'U') . colored(['bold bright_white'], 'S') . colored(['bold bright_blue'], 'A') if ($l =~ /^us/i);
$text .= colored(['bold bright_cyan'], sprintf("%${indent}s", $f)) . " = $l\n";
} else {
$text .= "$line\n";
}
} ## end foreach my $line (@in)
} else {
my $orig = $ENV{$env};
my $new;
if ($orig =~ /(256color)/) {
$new = colored(['red'], '2') . colored(['green'], '5') . colored(['yellow'], '6') . colored(['cyan'], 'c') . colored(['bright_blue'], 'o') . colored(['magenta'], 'l') . colored(['bright_green'], 'o') . colored(['bright_blue'], 'r');
$orig =~ s/$1/$new/g;
} elsif ($orig =~ /(truecolor)/) {
$new = colored(['red'], 't') . colored(['green'], 'r') . colored(['yellow'], 'u') . colored(['cyan'], 'e') . colored(['bright_blue'], 'c') . colored(['magenta'], 'o') . colored(['bright_green'], 'l') . colored(['bright_blue'], 'o') . ...
$orig =~ s/$1/$new/g;
} elsif ($orig =~ /(\d+\.\d+\.\d+\.\d+)/) {
$new = '[% BRIGHT GREEN %]' . $1 . '[% RESET %]';
$orig =~ s/$1/$new/g;
} elsif ($orig =~ /(ubuntu)/i) {
$new = '[% ORANGE %]' . $1 . '[% RESET %]';
$orig =~ s/$1/$new/g;
} elsif ($orig =~ /(redhat)/i) {
$new = colored(['bright_red'], $1);
$orig =~ s/$1/$new/g;
} elsif ($orig =~ /(fedora)/i) {
$new = colored(['bright_cyan'], $1);
$orig =~ s/$1/$new/g;
} elsif ($orig =~ /(mint)/i) {
( run in 1.969 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )