view release on metacpan or  search on metacpan

bin/bbs  view on Meta::CPAN

#!/usr/bin/env perl

# =============================================================
#  ____  ____ ____    _   _       _                          _
# | __ )| __ ) ___|  | | | |_ __ (_)_   _____ _ __ ___  __ _| |
# |  _ \|  _ \___ \  | | | | '_ \| \ \ / / _ \ '__/ __|/ _` | |
# | |_) | |_) |__) | | |_| | | | | |\ V /  __/ |  \__ \ (_| | |
# |____/|____/____/   \___/|_| |_|_| \_/ \___|_|  |___/\__,_|_|
#
# =============================================================
# BBS::Universal
# Copyright © 2023-2026 Richard Kelsch
# All Rights Reserved
# Licensed under the GNU Public License Version 3
#   See the LICENSE file for details

use 5.010;
use strict;
use English qw( -no_match_vars );
use utf8;
use charnames ':full';
use Config;
use open qw(:std :utf8);
no warnings;

# use Carp::Always;
# Use threads first, so others inherit
use threads (
    'yield',
    'stack_size' => 256 * 1024, # 256K
    'exit'       => 'threads_only',
    'stringify',
);

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;

BEGIN {
    our $VERSION = '0.014';
}

binmode(STDIN,  ':encoding(UTF-8)');
binmode(STDOUT, ':encoding(UTF-8)');
binmode(STDERR, ':encoding(UTF-8)');

our $OLDDIR         = getcwd;
our $LEVEL          = 'ERROR';
our $SERVER_THREADS = {};
our $RESTART        = FALSE;
our @CALL           = @ARGV;
our $SINGLE         = FALSE;
our $MPLAYER        = FALSE;
our $NOSOUND        = FALSE;

# Shared with threads

our $TEST = FALSE;

GetOptions(
    'test|sysop'     => \$TEST,
    'debug=s'        => \$LEVEL,
    'single'         => \$SINGLE,
    'nosound|silent' => \$NOSOUND,
);

our $DEBUG = Debug::Easy->new(
    'LogLevel' => $LEVEL,
    'Color'    => TRUE,
);

############## BBS Core ###################
$DEBUG->DEBUG(['Initializing BBS...']);

print cls,locate(1,1),'Initializing BBS...';
my $BBS_OBJ = BBS::Universal->small_new({ 'debug' => $DEBUG, 'debuglevel' => $LEVEL, 'nosound' => $NOSOUND });

$DEBUG->DEBUG(['Initializing Memcached']);
our $CACHE  = Cache::Memcached::Fast->new(
    {
        'servers' => [
            {
                'address' => $BBS_OBJ->{'CONF'}->{'MEMCACHED HOST'} . ':' . $BBS_OBJ->{'CONF'}->{'MEMCACHED PORT'},
            },
        ],
          'namespace'      => $BBS_OBJ->{'CONF'}->{'MEMCACHED NAMESPACE'},
          'utf8'           => TRUE,
          'close_on_error' => TRUE,

bin/bbs  view on Meta::CPAN

    my ($wsize, $hsize, $wpixels, $hpixels) = GetTerminalSize();

    $DEBUG->DEBUG(['Start Logo']);
    $CACHE->set('ROW_ADJUST', 0);
    my $version = sprintf('Version %.03f', $BBS::Universal::VERSION);
    my $banner  = colored(['red','on_black'],         q{  ____  ____ ____    _   _       _                          _  } . clline) . colored(['blue'], '│') . colored(['yellow', 'on_ansi17'],' [% VERSION %]                            ') . colored(['...
    $banner    .= colored(['yellow','on_black'],      q{ | __ )| __ ) ___|  | | | |_ __ (_)_   _____ _ __ ___  __ _| | } . clline) . colored(['blue'], '│') . colored(['yellow', 'on_ansi17'],' Written By Richard Kelsch                ') . colored(['...
    $banner    .= colored(['green','on_black'],       q{ |  _ \|  _ \___ \  | | | | '_ \| \ \ / / _ \ '__/ __|/ _` | | } . clline) . colored(['blue'], '│') . colored(['yellow', 'on_ansi17'],' Copyright © 2023-2026 Richard Kelsch     ') . colored([...
    $banner    .= colored(['magenta','on_black'],     q{ | |_) | |_) |__) | | |_| | | | | |\ V /  __/ |  \__ \ (_| | | } . clline) . colored(['blue'], '│') . colored(['yellow', 'on_ansi17'],' All Rights Reserved                      ') . colored(['...
    $banner    .= colored(['bright_blue','on_black'], q{ |____/|____/____/   \___/|_| |_|_| \_/ \___|_|  |___/\__,_|_| } . clline) . colored(['blue'], '│') . colored(['yellow', 'on_ansi17'],' Licensed Under The Perl Artistic License ') . colored(['...
    $banner    .= colored(['blue','on_black'], '━' x 63 . '┷' . '━' x 42 . '┷') . "\n";
    $banner =~ s/\[\% VERSION \%\]/$version/s;

    print setscroll(1, $hsize), locate(1, 1);
    $banner .= locate(6,108) . colored(['blue','on_black'], '━' x ($wsize - 107));
    print $banner;
    print locate($CACHE->get('START_ROW'), 1),  cldown;
    $DEBUG->DEBUG(['End Logo']);
    return ($wsize, $hsize, $wpixels, $hpixels);
}

__END__

=pod

=encoding utf8

=head1 NAME

 BBS::Universal

 =============================================================
  ____  ____ ____    _   _       _                          _
 | __ )| __ ) ___|  | | | |_ __ (_)_   _____ _ __ ___  __ _| |
 |  _ \|  _ \___ \  | | | | '_ \| \ \ / / _ \ '__/ __|/ _` | |
 | |_) | |_) |__) | | |_| | | | | |\ V /  __/ |  \__ \ (_| | |
 |____/|____/____/   \___/|_| |_|_| \_/ \___|_|  |___/\__,_|_|

 =============================================================

=head1 DESCRIPTION

A Universal BBS that connects to TCP/IP instead of serial

It works with a variety of text encoding formats

NOTE:  The System Operator terminal MUST support UTF-8!  This gives graphics character support.

=head1 OPTIONS

=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

This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at:

L<http://www.perlfoundation.org/artistic_license_2_0>

Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not ...

If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license.

This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder.

This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are ne...

Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCL...

=cut