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:
############################################################################### # Author: Adrian Immanuel Kiess < https://www.kiess.onl > # License: BSD, see LICENSE file # What: Module for outanekka.kiess.onl ############################################################################### package text; use strict; use warnings; use CGI qw/:standard escapeHTML -utf8/; use CGI::Carp qw(warningsToBrowser fatalsToBrowser carpout set_message set_die_handler confess); use imagery::album; use imagery::image; use user::account; =head1
############################################################################### # Author: Adrian Immanuel Kiess < https://www.kiess.onl > # License: BSD, see LICENSE file # What: Module for outanekka.kiess.onl ############################################################################### package config; use strict; use warnings; use utf8; use CGI::Carp qw(warningsToBrowser fatalsToBrowser carpout set_message set_die_handler confess); =head1
.29'; our $VER = sprintf("%vd", $VERSION); our $REF = $conf::sitePath; our $NAME = $conf::siteName; our $Q_MODULE = $q->param('module'); our $Q_ACTION = $q->param('action'); our $MODULE = __PACKAGE__; =head2 FUNCTIONS =over 4 =item run() run() is called from index.pl. =cut sub run { if (!$Q_MODULE or ($Q_MODULE and $Q_MODULE eq 'theme')) { my $v = $q->p({-class=>'about-modules'}, &about::module::moduleVersion($MODULE, $VER) . &about::module::moduleVersion('basic', $basic::VER) . &about::module::moduleVersion('config', $config::VER) . &about::module::moduleVersion('html', $html::VER) . &about::module::moduleVersion('text', $text::VER) . &about::module::moduleVersion('theme', $theme::VER)); return &home::page() . $v; } } =item page() page() prints the homepage. =cut sub page { return # $q->h1
; # vim: noai:sts=2 sw=2 ts=2 # # EOF
; #$CACHE_ALBUMS =~ m/$PATH_REGEX/; #$CACHE_ALBUMS = $1
; # vim: noai:sts=2 sw=2 ts=2 # # EOF
6; our $NICK_LENGTH_MIN = 1
DESCRIPTION This module will offer bassic informations about this software to the user. Additionally, one can set site specific informations to be presented to the user. =head2 STATUS The status is to be considered stable. =cut $| = 1
'; our $PAGE_REFRESH = 60; # READY MOVE TO CHATBOX.PM our $benchmarkA = \$main::benchmarkA; our $cookie = \$main::cookie; # READY MOVE TO USER.PM our $BASE = 'index.pl'; our $COPYRIGHT_URL = $conf::copyrightUrl; our $REF = $conf::sitePath; our $NAME = $conf::siteName; our $STATS_URL = $conf::siteStats; our $TITLE = $conf::siteTitle; our $WEBMASTER = $conf::siteWebmaster; our $Q_MODULE = $q->param('module'); our $Q_ACTION = $q->param('action'); our $Q_ID = $q->param('id'); our $Q_PATH = $q->param('path'); our $PATHLENGTH = 255; =head2 FUNCTIONS =over 4 =item run() run() is called from index.pl while building the main content of the current page. The following logic will decide what to execute inside here. =cut sub run { my $header = &html::header(); my $topbar = &html::topbar(); my $navmenu = &html::navmenu(); my $navmenuUser = &user::page::navmenu(); my $middleBegin = &html::middleBegin(); my $middle = &html::middle(); my $right = &html::right(); my $bottombar = &html::bottombar(); #### standard reporting functionality #msg( &basic::getFailureMessage( "Database","Connecting to database")); #error( "Database connection failed! "); #debug( "Connection arguments were! "); return $header . $topbar . $q->div({-class=>'topbar-nav'}, $q->div({-style=>'float:right;'}, $navmenu ) . $navmenuUser ) . $middleBegin . ($main::locallog || ""). Log::Message::Simple->stack_as_string . $middle . $right . $bottombar; } =item header() header() returns the header of a page. =cut sub header { my $stylesheet .= qq| } img { behavior: url("pngbehavior.htc"); }\n|; my $siteUrl = $conf::siteUrl; my $chatboxREF = "/chatbox/"; $chatboxREF =~ s/^\/// if $siteUrl =~ m/\/$/; return ($$cookie ? $q->header(-type=>'text/html', -charset=>"UTF-8", -cookie=>$$cookie) : $q->header(-type=>'text/html', -charset=>"UTF-8")) . $q->start_html( -encoding => "UTF-8", -title=>$NAME . ($Q_MODULE ? ' : '.$Q_MODULE : ''). ($Q_ACTION ? ' : '.$Q_ACTION : ''). ($Q_ID ? ' : '.$Q_ID : ''). ($Q_PATH ? ' : '.$Q_PATH : ''), #-base=>'true', -meta=>{'copyright'=> 'BSD', 'publisher'=> $AUTHOR, 'description'=> $TITLE, 'generator'=> $NAME . ' ' . $BASE . ' ' . $main::VER}, -style=>{-code=> $stylesheet}, -head=>[ $q->Link({-rel=>'Stylesheet', -href=>&theme::getDefaultCSS(), -type=>'text/css'}), $q->Link({-rel=>'Stylesheet', -href=>&theme::getThemeCSS(), -type=>'text/css'}), $q->Link({-rel=>'shortcut icon', -href=>$REF.'favicon.ico', -type=>'image/x-icon'}), (($Q_MODULE and ($Q_MODULE eq "chatbox")) ? $q->meta({-http_equiv => 'Refresh', -content=> "$chatbox::PAGE_REFRESH; URL=$siteUrl$chatboxREF"}) : "") ], ); } =item topbar() topbar() returns the top corner of a page. =cut sub topbar { my $img; my $img_src = &theme::getBannerImage(); #if ($ENV{'HTTP_USER_AGENT'} and $ENV{'HTTP_USER_AGENT'} !~ /MSIE/) { #} else { #$img_style = "filter:progid:DXImageTransform.Microsoft.AlphaImageLoader(". #"src='".$img_src."";".',sizing='scale');"; #} $img = $q->a({-href=>$REF}, $q->img({-src=>$img_src, -title=>$TITLE, -alt=>$TITLE})) . $q->div({-class=>'loading'},''); #'loading the page...'); return $q->div({-class=>'topbar', -title=>$NAME}, $q->div({-class=>'topbar-text'}, $img . $q->div( 'theme » ' . &theme::themeLinks() . &user::page::topbar() ) ) ); } =item navmenu() navmenu() returns the navigation menu of a page. =cut sub navmenu { return "\n<!-- navmenu() -->\n". $q->ul({-id=>'navmenu'}, $q->li({-style=>'margin-right:1
50,1
; # vim: noai:sts=2 sw=2 ts=2 # # EOF
; # vim: noai:sts=2 sw=2 ts=2 # # EOF
&& ($randLine = $_) while <MO>; close(MO); #$randLine = HTML::Entities::encode($randLine); $module =~ s/\.pm$//i; $module =~ s/^modules\///i; $module =~ s/\//::/i; no strict 'refs'; if (${ $module.'::VER' } and ${ $module.'::LASTEDIT'}) { return $q->li({-id=>$module}, $q->a({-href=>$$REF.'#'.$module},$module), "is v${ $module.'::VER' }\, last edit: ${ $module.'::LASTEDIT'}\.", $q->p($q->pre({-style=>'font-size:1
############################################################################### # Author: Adrian Immanuel Kiess < https://www.kiess.onl > # License: BSD, see LICENSE file # What: Module for outanekka.kiess.onl ############################################################################### package guestbook::page; use strict; use warnings; use CGI qw/:standard escapeHTML -utf8/; use CGI::Carp qw(warningsToBrowser fatalsToBrowser carpout set_message set_die_handler confess); use POSIX qw/strftime/; use Encode qw(decode_utf8); use guestbook; use guestbook::opinion; =head1
; } &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
6; $| = 1
AUTHOR Adrian Immanuel Kiess - < http://www.kiess.onl/ > =cut 1
2;') . $q->a({-title=>"User " . $nick . " is " . $class, -href=>$$REF . 'profile/' . $nick}, $nick)); } else { return undef; } return undef; } =item linkEditAccount() linkEditAccount() returns a link pointing to the user account modification page. =cut sub linkEditAccount { my $uid = shift; if ($uid and &user::account::exists($uid) and ((&user::session::getAccountId() eq ($uid)) or (&user::session::getAccountLevel() >= 255))) { my $nick = &user::account::queryNick($uid); $q->param('module', $$MODULE); $q->param('action', 'accountedit'); $q->param('id', $uid); return $q->start_form({-action=>$$REF . "accountedit"}) . $q->hidden('module') . $q->hidden('action') . $q->hidden('id') . $q->submit(-style=>'padding-left: 20px; padding-right: 20px;', -name=>'view', -value=>"edit " . $nick . "'s account >>", -label=>"edit " . $nick . "'s account >>" ) . $q->end_form(); } else { return undef; } } =item linkEditProfile() linkEditProfile() returns a link pointing to the user profile modification page. =cut sub linkEditProfile { my $uid = shift; if ($uid and &user::account::exists($uid) and ((&user::session::getAccountId() eq ($uid)) or (&user::session::getAccountLevel() >= 255))) { my $nick = &user::account::queryNick($uid); $q->param('module', $$MODULE); $q->param('action', 'profileedit'); $q->param('id', $uid); return $q->start_form({-action=>$$REF . "profileedit"}) . $q->hidden('module') . $q->hidden('action') . $q->hidden('id') . $q->submit(-style=>'padding-left: 20px; padding-right: 20px;', -name=>'view', -value=>"edit " . $nick . "'s profile >>", -label=>"edit " . $nick . "'s profile >>" ) . $q->end_form(); } else { return undef; } } =item randomNick() randomNick() returns a random nick suggestion. =cut sub randomNick { my ($randomNick); my $r = new String::Random; # define vowels $r->{'V'} = [ qw(a e i o u) ]; # define common consonants $r->{'Q'} = [ qw(r s t n m) ]; # e.g. retom, satan, timis ... $randomNick = $r->randpattern("QVQVQ"); return $randomNick; } =item randomPassword() randomPassword() returns a random password suggestion. =cut sub randomPassword { my ($randomPassword); my $r = new String::Random; $randomPassword = $r->randpattern("CcCnCnCn"); return $randomPassword; } =item loginLink() loginLink() returns a generic login link for logging into outanekka. =cut sub loginLink { return $q->a({-href=>$$REF . "login"},"log in"); } =item exists() exists() check's if the user is known to outanekka. =cut sub exists { my $uid = shift; #confess unless $uid; if ($uid and ($uid =~ m/^(\d+)$/)) { my ($sth, $href, $uidDb); $sth = $::dbh->prepare(qq{ SELECT id FROM $$MODULE WHERE id=(?) }) or die $::dbh->errstr; $sth->execute($uid) or die $::dbh->errstr; #$uidDb = $sth->fetchrow; #$uidDb = $sth->fetchrow; $href = $sth->fetchrow_hashref(); $uidDb = $href->{'id'}; return ($uidDb ? $uidDb : undef); } return undef; } =item queryId() queryId() queries for the accounts ID by a given user nick. =cut sub queryId { my $nick = shift; if ($nick) { my ($sth, $uid); $nick = lc $nick if $nick; $sth = $::dbh->prepare(qq{ SELECT id FROM $$MODULE WHERE nick=(?) }) or die $::dbh->errstr; $sth->execute($nick) or die $::dbh->errstr; $uid = $sth->fetchrow; return $uid ? $uid : undef; } } =item queryNick() queryNick() queries for the accounts nick by a given account ID. =cut sub queryNick { my $uid = shift; if ($uid and ($uid =~ m/^(\d+)$/)) { my ($sth, $nick); $sth = $::dbh->prepare(qq{ SELECT nick FROM $$MODULE WHERE id=? }) or die $::dbh->errstr; $sth->execute($uid) or die $::dbh->errstr; $nick = $sth->fetchrow; $nick = lc $nick if $nick; return $nick ? $nick : undef; } return undef; } =item queryPassword() queryPassword() queries for the accounts nick by a given account ID. =cut sub queryPassword { my $uid = shift; if ($uid and ($uid =~ m/^(\d+)$/)) { my ($sth, $password); $sth = $::dbh->prepare(qq{ SELECT password FROM $$MODULE WHERE id=? }) or die $::dbh->errstr; $sth->execute($uid) or die $::dbh->errstr; $password = $sth->fetchrow; return $password ? $password : undef; } return undef; } =item queryEmail() queryEmail() queries for the accounts nick by a given account ID. =cut sub queryEmail { my $uid = shift; if ($uid and ($uid =~ m/^(\d+)$/)) { my ($sth, $email); $sth = $::dbh->prepare(qq{ SELECT email FROM $$MODULE WHERE id=? }) or die $::dbh->errstr; $sth->execute($uid) or die $::dbh->errstr; $email = $sth->fetchrow; return $email ? $email : undef; } return undef; } =item queryRightslevel() queryRightslevel() queries for the accounts rightslevel by a given account ID. =cut sub queryRightslevel { my $uid = shift; if ($uid and ($uid =~ m/^(\d+)$/)) { my ($sth, $rightslevel); $sth = $::dbh->prepare(qq{ SELECT rightslevel FROM $$MODULE WHERE id=? }) or die $::dbh->errstr; $sth->execute($uid) or die $::dbh->errstr; $rightslevel = $sth->fetchrow; return $rightslevel ? $rightslevel : undef; } return undef; } =item queryCreated() queryCreated() queries for the accounts creation date by a given account ID. =cut sub queryCreated { my $uid = shift; if ($uid and ($uid =~ m/^(\d+)$/)) { my ($sth, $created); $sth = $::dbh->prepare(qq{ SELECT created FROM $$MODULE WHERE id=? }) or die $::dbh->errstr; $sth->execute($uid) or die $::dbh->errstr; $created = $sth->fetchrow; return $created ? $created : undef; } return undef; } =item queryImpressions() queryImpressions() queries for the impressions a user generated by a given account ID. =cut sub queryImpressions { my $uid = shift; if ($uid and ($uid =~ m/^(\d+)$/)) { my ($sth, $impressions); $sth = $::dbh->prepare(qq{ SELECT impressions FROM $$MODULE WHERE id=? }) or die $::dbh->errstr; $sth->execute($uid) or die $::dbh->errstr; $impressions = $sth->fetchrow; return $impressions ? $impressions : undef; } return undef; } =item count() count() counts the user database record entries. =cut sub count { my ($count); $count = $::dbh->selectrow_array(qq{ SELECT COUNT(*) FROM $$MODULE }); return $count; } =head1
; # vim: noai:sts=2 sw=2 ts=2 # # EOF
AUTHOR Adrian Immanuel Kiess - < http://www.kiess.onl/ > =cut 1
00'); last; }; m/image\/svg\+xml|image\/x-mvg/ && do { $givenFile = $givenFile . "\.png"; #$image->Set(Density=>'4200'); #$image->Set(Size=>'2200x2200'); #$image->Size('2200x2200'); #$image->Set(Alpha=>'off'); last; }; m/image\/x-webp/ && do { $givenFile = $givenFile . "\.webp"; last; }; m/image\/x-xcf/ && do { $givenFile = $givenFile . "\.png"; last; }; $givenFile = $givenFile . "\.jpeg"; } } $sth = $::dbh->prepare(qq{ SELECT id FROM $$MODULE WHERE image=(?) AND album_id=(?) LIMIT 1
1
.4; my $cropWidth = int($widthOriginal/$cropSpectrum); my $cropHeight = int($heightOriginal/$cropSpectrum); my $cropX = ($widthOriginal - $cropWidth)/2; my $cropY = ($heightOriginal - $cropHeight)/2; $imageMagick->Crop(width=>$cropWidth, height=>$cropHeight, x=>$cropX, y=>$cropY); $imStdout = $imageMagick->Resize(geometry => $widthOut . "x" . $heightOut ); die $imStdout if $imStdout; $imageMagick->Quantize(colors=>256, dither=>'False'); $imageMagick->Set(interlace=>'Plane'); $imageMagick->Set(comment=>"Image generated by " . $::conf::siteUrl . " -- (c) " . $::conf::siteAuthor . ""); $imageMagick->Comment("Image generated by " . $::conf::siteUrl . " -- (c) " . $::conf::siteAuthor . ""); $imageMagick->Set(quality=>$imageQuality); #$image =~ s/$$AIEXT/.png/i; $imStdout = $imageMagick->Write($pathOut . $imageOut); $widthOut = $imageMagick->Get('width'); $heightOut = $imageMagick->Get('height'); $sizeOut = $imageMagick->Get('filesize'); &imagery::album::updateRecord($aid, $imageOut, $widthOut, $heightOut, $mimeOut); return ($image, $widthOut, $heightOut, $sizeOut, $mimeOut); } else { } } elsif ($image) { &imagery::album::updateRecord($aid, $imageOut, $widthOut, $heightOut, $mimeOut); #&basic::failureMessage("Database or file record missing", # "The database entry or file of album #" . $aid . " is missing"); } return undef; } =item unknown() unknown() =cut sub unknown { my $album = shift || 'unknown'; &basic::failureMessage('Unknown album', "Our apologies, the album " . $q->b($album) . " does not exist (anymore)." ); } =item verifyAlbumMaxDepth() verifyAlbumMaxDepth() =cut sub verifyAlbumMaxDepth { my $path = shift; confess unless $path; if (&imagery::pathDepth($path) < $conf::albumMaxDepth) { return $path; } return undef; } =head1
############################################################################### # 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
: return undef; } =item verifyFreeSpace() verifyFreeSpace() =cut sub verifyFreeSpace { my $uid = shift; confess unless $uid; ((&freeSpace($uid) > 0) or (&user::session::getAccountLevel() >= 255)) ? return 1
SYNOPSIS A outanekka chatbox module. =head1
2; our $LASTEDIT = '1