You can support the outanekka.KIESS.ONL — online multiuser image display solution with additional features! development as well as take a share of the server hosting costs by donating a small amount of money.
The outanekka base arrived at version 0.9.0.16 and is developed by Adrian Immanuel Kieß.
You can contact Adrian Immanuel Kieß under:
Outanekka is the so called summary of all those below listed modules and additional files:
; # vim: noai:sts=2 sw=2 ts=2 # # EOF
AUTHOR Adrian Immanuel Kiess - < http://www.kiess.onl/ > =cut 1
############################################################################### # Author: Adrian Immanuel Kiess < https://www.kiess.onl > # License: BSD, see LICENSE file # What: Module for outanekka.kiess.onl ############################################################################### package home; use strict; use warnings; use CGI; use CGI::Carp qw(warningsToBrowser fatalsToBrowser carpout set_message set_die_handler confess); use about::module; use imagery::page; =head1
; our $q = new CGI; our $VERSION = 0.9.0.1
) {
$subAlbumId = &imagery::album::queryId($1; # vim: noai:sts=2 sw=2 ts=2 # # EOF
; our $PROFILE_ENTRY_MAX = 1
; our $q = new CGI; our $VERSION = 0.9.0.1
px;'},
$q->a({-href=>$conf::siteUrl},$conf::siteName . ' v'.$main::VER) .
' (' . $YEAR_BEGUN . '–' . (strftime "%Y",gmtime($^T)) . ') ' .
' by ' .
$q->a({-href=>$conf::siteAuthorUrl},$AUTHOR) .
' ♦ ' .
$q->a({-href=>$COPYRIGHT_URL},"BSD licensed") .
$q->br() .
'Designed for the ' .
$q->a({-href=>'https://www.mozilla.org/'},'Mozilla browser') .
' ♦ ' .
$NAME.' ' .
$q->a({-href=>$STATS_URL},' usage statistics') .
$q->br() .
$q->a({-href=>'https://www.perl.org/'},'Perl') .
' code runtime:' .
timestr($benchmark)
) .
#qq'<style type="text/css">
# .loading { visibility:hidden; }
# </style>' .
$q->div({-class=>'bottombar-sys',-style=>''},
$q->pre({-style=>'display: inline-block; text-align:left;'},$::mu->record('near exit') .
$::mu->report())) .
$q->end_html();
}
=head1 DESCRIPTION
Provides basic routines needed for outanekka.
=head2 STATUS
The status is considered unstable.
=cut
BEGIN {
my @sql = (
qq{CREATE TABLE IF NOT EXISTS impression (
impressions BIGINT UNSIGNED,
unixtime BIGINT UNSIGNED default NULL
);
},
#qq{},
);
for (@sql) {
my $sth = $main::dbh->prepare($_) or die $main::dbh->errstr;
$sth->execute or die $main::dbh->errstr;
$sth->finish;
}
#$::dbh->do(});
}
$| = 1 DESCRIPTION
The guestbook module allows unauthorized users to leave their opinion.
A superuser can edit and delete entries.
In conclution it is - well, a simple guestbook.
=head2 STATUS
The status is considered stable.
=cut
BEGIN {
my @sql = (
qq{CREATE TABLE IF NOT EXISTS guestbook (
id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT,
opinion TEXT,
email TINYTEXT,
unixtime BIGINT UNSIGNED default NULL,
PRIMARY KEY (id)
);
},
#qq{ALTER TABLE guestbook MODIFY COLUMN id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT;},
);
for (@sql) {
my $sth = $main::dbh->prepare($_) or die $main::dbh->errstr;
$sth->execute or die $main::dbh->errstr;
$sth->finish;
}
}
$| = 16;
our $LASTEDIT = '20.09.23';
our $VER = sprintf("%vd", $VERSION);
our $MODULE = \$about::MODULE;
our $REF = \$about::REF;
our $PATH_MODULES = \$about::PATH_MODULES;
our $Q_MODULE = \$about::Q_MODULE;
our $Q_ACTION = \$about::Q_ACTION;
=item viewModules()
viewModules() prints random portions of source code from outanekka as page output.
=cut
sub viewModules {
my @modules = &about::module::modules($$PATH_MODULES);
my $o;
$o .= $q->h1; # vim: noai:sts=2 sw=2 ts=2 # # EOF
AUTHOR Adrian Immanuel Kiess - < http://www.kiess.onl/ > =cut 1
;
}
&basic::failureMessage("Removing opinion failed",
"Could not remove opinion #" . ($id || "undefined") . "\!");
return undef;
}
=item browse()
browse() returns a list of opinions limitted by SKIP.
=cut
sub browse {
my $skip = shift || $$SKIP;
my $navbar;
my $sth;
my $entries = $::dbh->do("select last_insert_id( ) from $$MODULE;");
my $opinions;
($navbar, $skip) = &basic::navigation(
$entries, # Total entries
$$REF, # URL basepath
"opinions", # Name
$$SKIP); # Entries per page
if (defined $skip and $skip =~ /(^\d+)$/ and $navbar and $entries) {
$sth = $::dbh->prepare(qq{
SELECT * FROM $$MODULE ORDER BY id DESC LIMIT $skip,$$SKIP
}) or die $::dbh->erstr;
$sth->execute() or die $::dbh->errstr;
while ( my $ref = $sth->fetchrow_hashref ) {
$opinions .= &link($ref->{id},
$ref->{opinion},
$ref->{email},
$ref->{unixtime}
);
}
if ($opinions) {
return $navbar . $opinions . $navbar;
}
else {
return undef;
}
}
else {
return undef;
}
}
=item link()
link() returns the link to an opinion as HTML formatted output.
=cut
sub link {
my $id = shift;
my $opinion = shift;
my $email = shift;
my $unixtime = shift;
if ($id and $id =~ m/^\d+$/) {
my $date = strftime "%B %d, %Y",gmtime($unixtime);
$email = &text::leetEmail($email);
$opinion = &text::formattedText($opinion);
return $q->div({-class=>"textbox",
-id=>$id,
-title=>"Opinion \#$id by $email"},
$q->div({-class=>"textbox-subformation"},
"( " . $email ." @ " . $date . " ) " ,
( &user::session::getAccountLevel() >= 255 ) ?
$q->span(" [ " .
$q->a({-href=>$$REF."edit/$id"},"¿ edit") . " ] [ " .
$q->a({-href=>$$REF."delete/$id"},"Χ delete") . " ]"
) : "" # no rights
) .
$q->div({-class=>"textbox-content"},$opinion)
);
}
}
=item queryRecord()
queryRecord() returns the database record of the given opinion ID.
=cut
sub queryRecord {
my $id = shift || $$Q_ID;
my ($sth, $href);
if ($id and ($id =~ m/^(\d+)$/)) {
$sth = $::dbh->prepare(qq{
SELECT opinion, email FROM $$MODULE WHERE id=(?)
}) or die $::dbh->errstr;
$sth->execute($id) or die $::dbh->errstr;
$href = $sth->fetchrow_hashref;
if ($href) {
return $href;
}
}
return undef;
}
=item matches()
matches() searches for a similiar already existing opinion in the database.
=cut
sub matches {
my $email = shift || $q->param('email');
my $opinion = shift || $q->param('opinion');
if ($email and $opinion) {
my ($sth, $href);
$sth = $::dbh->prepare(qq{
SELECT id FROM $$MODULE WHERE email LIKE (?) AND opinion LIKE (?)
}) or die $::dbh->errstr;
$sth->execute('%'.$email.'%', '%'.$opinion.'%') or die $::dbh->errstr;
$href = $sth->fetchrow_hashref;
if ($href and $href->{'id'} and ($href->{'id'} =~ m/^(\d+)$/)) {
return 1############################################################################### # Author: Adrian Immanuel Kiess < https://www.kiess.onl > # License: BSD, see LICENSE file # What: Module for outanekka.kiess.onl ############################################################################### package user::profile; use strict; use warnings; use CGI qw/:standard escapeHTML -utf8/; use CGI::Carp qw(warningsToBrowser fatalsToBrowser carpout set_message set_die_handler confess); use Encode qw(decode encode); use POSIX qw/strftime/; #use contributed::Random; use user; =head1
("List of users at $::conf::siteName") .
$q->h2("User list") .
$q->p("There are " . $q->b($q->big($count)) . " registered users at " . $::conf::siteName . ".") .
$q->p(
$q->table({-border=>0,-width=>'16; our $LASTEDIT = '20.07.21
WHERE id=?
}) or warn $::dbh->ersstr;
$sthUpdateAccount->execute($$accountId) or die $::dbh->errstr;
confess unless $$accountId && $$accountId =~ /^\d+$/ &&
$$accountNick && $$accountLevel && $$accountLevel =~/^\d+$/ &&
$$sessionKey;
}
}
}
}
=item login()
login() let's the user login to outanekka.
=cut
sub login {
my $user = shift || $q->param('user') || undef;
my $password = shift || $q->param('password');
my $html;
if ($password and &user::session::hasSession()) {
&basic::successMessage("Logged in into " . $conf::siteName,
$q->b("Welcome $$accountNick!") . " I'm glad to have you back again.");
return $user;
} else {
if ($user and $password) {
&basic::failureMessage("Password mismatch",
qq/Sorry, the password you gave me did not match the one I had.
You maybe made a typo. Please try again./);
} elsif ($password and !$user) {
&basic::failureMessage("Username missing",
qq/Please enter your username in the user field./);
} elsif ($user and !$password) {
&basic::failureMessage("Password missing",
qq/Please enter your password in the password field./);
}
return undef;
}
}
=item preLogout()
preLogout() clears the user session at the beginning of the outanekka logics.
=cut
sub preLogout {
if ($$Q_MODULE and ($$Q_MODULE eq $$MODULE) and
($$Q_ACTION and (($$Q_ACTION eq "logout") or ($$Q_ACTION eq "delete")))) {
my $givenSessionKey = $q->cookie("session_key");
if ($givenSessionKey) {
#my $sth = $::dbh->prepare(qq{
# DELETE FROM $$MODULE\_session
# WHERE session_key=?
#}) or die $::dbh->errstr;
#$sth->execute($givenSessionKey) or die $::dbh->errstr;
my $sth = $::dbh->prepare(qq{
UPDATE $$MODULE\_session SET session_expires=(?),
session_key=(?)
WHERE session_key=(?)
}) or die $::dbh->errstr;
$sth->execute($SESSION_EXPIRES_REMEMBER, "", $givenSessionKey) or die $::dbh->ersstr;;
#if ($sth) {
$::cookie = $q->cookie(
-NAME => 'session_key',
-VALUE => 'logged out',
-EXPIRES => '+19';
our $VER = sprintf("%vd", $VERSION);
our $MODULE = \$imagery::MODULE;
our $REF = \$imagery::REF;
our $REF_IMAGE = \$imagery::REF_IMAGE;
our $REF_VIEW = \$imagery::REF_VIEW;
our $REF_LOCAL = \$imagery::REF_LOCAL;
our $PATH_ALBUMS = \$imagery::PATH_ALBUMS;
our $PATH_CACHES = \$imagery::PATH_CACHES;
our $CACHE_THUMBS = \$imagery::CACHE_THUMBS;
our $THUMB_MD = \$imagery::THUMB_MD;
our $PATH_REGEX = \$imagery::PATH_REGEX;
our $IMAGE_REGEX = \$imagery::IMAGE_REGEX;
=head2 FUNCTIONS
=over 4
=item link()
link()
=cut
sub link {
my $iid = shift;
if ($iid and &imagery::image::exists($iid)) {
my ($href);
($href) = &imagery::thumb::queryRecord($iid);
if ($href) {
my $nick = &user::account::queryNick($href->{'user_id'});
$href->{'impressions'} = $href->{'impressions'} ? $href->{'impressions'} : 100'); $imageQuality = 1
= 'Randomn Images';
}
if ($navName eq 'images') {
$count = &imagery::image::count();
} else {
$count = &imagery::album::count();
}
($navigation, $skip) = &basic::navigation(
$count, # Total entries
$$REF . $$Q_ACTION, # URL basepath
$navName, # Name
$$PAGE_THUMBS # Entries per page
);
$o .= $q->h1 . '/';
$oldAlbum = $2;
}
$renamePath = $subPath . $renameAlbum . '/';
if ( &imagery::pathDepth($path) <= 1############################################################################### # Author: Adrian Immanuel Kiess < https://www.kiess.onl > # License: BSD, see LICENCE file # What: Module for outanekka.kiess.onl ############################################################################### package imagery::daily; use strict; use warnings; use utf8; use CGI qw/:standard escapeHTML -utf8/; use CGI::Carp qw(warningsToBrowser fatalsToBrowser carpout set_message set_die_handler confess); use POSIX qw(strftime); =head1
6; our $LASTEDIT = '20.07.1
;
} else {
return undef;
}
return undef;
}
return undef;
}
=item history()
history() lets the user browse through the chatbox history.
=cut
sub history {
my $skip = shift || $$Q_SKIP || 0;
#my $skip = ($q->param('skip') &&
# $q->param('skip') =~ m/^[0-9]+$/) ? $q->param('skip') : 0;
my ($o, $sth, $href, $count);
if (&user::session::hasSession()) {
$q->param('chatboxMessage','');
$q->param('action','create');
$o .= $q->div(
$q->start_form(-style=>'padding:0px;',
-method=>'',
-action=>$$REF),
$q->hidden(-name=>'module',-default=>'chatbox'),
$q->hidden(-name=>'action',-default=>'create'),
"Your message:",$q->br(),
$q->textfield(-style=>'width:51;
}
else {
&basic::failureMessage("Message not deleted",
"The message \#$id could " . $q->b("not") . " be deleted.");
}
}
return undef;
}
=item link()
link() formats the message for output to the user.
=cut
sub link {
my $id = shift;
my $uid = shift;
my $msg = shift;
my $unixtime = shift;
if ($id and $uid and $msg) {
my $o;
if ($unixtime) {
my $gmtime = strftime "%b %d, %R", gmtime($unixtime);
if (&user::session::getAccountLevel() >= 255) {
$o .= $q->small(" [ " .
$q->a({-href=>$$REF."delete/$id"},"delete " . $q->b("↵")) . " ] ");
}
$o .= $q->i($gmtime);
}
$msg = &text::formattedText($msg);
$msg = &text::insertSpaces($msg,'1
