Fix parser, use regexes instead of substr, duh

.gitignore

@@ -0,0 +1 @@
+vendor_perl/**

.perlcriticrc

@@ -0,0 +1,103 @@
+#!/usr/bin/env perlcritic
+severity    = 5
+verbose     = 8
+
+# minorify some of warnings that are not really critical
+[-InputOutput::RequireCheckedClose]
+# What can we handle in case of error?
+
+[-Modules::ProhibitExcessMainComplexity]
+# Noone cares
+
+[-Subroutines::ProhibitExcessComplexity]
+# Noone cares
+
+[-Subroutines::ProhibitExplicitReturnUndef]
+# But it's very handy sometimes!
+
+[-ValuesAndExpressions::ProhibitMagicNumbers]
+# this policy makes too much false positives
+
+[-RegularExpressions::RequireLineBoundaryMatching]
+# We use /m as needed
+
+[-RegularExpressions::RequireExtendedFormatting]
+# We do not use extended formatting of regex, they still not THAT complex
+
+[-RegularExpressions::RequireDotMatchAnything]
+# huh?
+
+[-RegularExpressions::ProhibitEscapedMetacharacters]
+# Looks like it pointless
+
+[-ControlStructures::ProhibitCascadingIfElse]
+# I like long if..else chains
+
+[-ControlStructures::ProhibitPostfixControls]
+# In short lines we can afford ourselves to use postfix controls
+# but of course we should avoid such constructions in long lines.
+
+[-Subroutines::ProhibitSubroutinePrototypes]
+# Contrary to  Perl::Critic  we consider prototypes as useful, even if
+# the compile-time checks of Perl are not perfect,  Perl may give some
+# hints.
+
+[-CodeLayout::RequireTidyCode]
+# Impossible to complete, because of on higher linting levels "## no critic..."
+# require be per-case on same line where critique is, but tidy align them
+# one line down.
+
+[-CodeLayout::ProhibitParensWithBuiltins]
+# duh...
+
+[-ValuesAndExpressions::ProhibitEmptyQuotes]
+# cause we consider following correct and useful:  my $var = '';
+# the recommended use of q{} looks too complex:     my $var = q{};
+
+[-ValuesAndExpressions::ProhibitNoisyQuotes]
+# Other people, other opinions: ","  is better readable than qw(,)
+
+[-BuiltinFunctions::ProhibitSleepViaSelect]
+# We do not wish to use too much external modules.
+# select undef, undef, undef, 0.25; # actually is okay if you add comment that
+# it is sleep for 0.25 seconds
+
+[-NamingConventions::Capitalization]
+# duh...
+# Noone cares, really
+
+[-ControlStructures::ProhibitUnlessBlocks]
+# They should not be too complex - only one condition should be checked,
+# that's all
+
+[-Miscellanea::ProhibitTies]
+# Just allow it. It's very handy stuff and extremely simple and safe enough to use.
+
+[-ValuesAndExpressions::RequireNumberSeparators]
+# Not really
+
+[-InputOutput::RequireBracedFileHandleWithPrint]
+# We prefer not to use braced file handles
+
+[-Documentation::PodSpelling]
+# It doesn't help, but emits annoying errors
+
+[Documentation::RequirePodSections]
+# Considering this as "soft" requirement. For modules that is (or will be)
+# stand-alone libs well formed documentation is highly desired.
+lib_sections    = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
+
+[-ErrorHandling::RequireCheckingReturnValueOfEval]
+# In this app eval is not critical to error, so there is no need to check for it
+
+[-InputOutput::RequireBriefOpen]
+# Yes, i do!
+
+[-InputOutput::RequireCheckedSyscalls]
+# What can go wrong in "say"? what and how should i handle in this case?
+
+[-ControlStructures::ProhibitDeepNests]
+# Oh, really? Maybe you know better solution?
+
+[-Variables::ProhibitPunctuationVars]
+# I don't want use English here

README.md

@@ -21,7 +21,8 @@
 видосик во временный каталог, отдаёт видосик клиенту. Есть встроенное
 ограничение на размер файла в 10Мб.
 
-N.B. Файлы из временного каталога автоматически не вычищаются.
+N.B. Файлы из временного каталога автоматически не вычищаются. Получается
+своего рода "перманентный" кэш.
 
 ## Как это запустить?
 

cpanfile

@@ -1,3 +1,4 @@
-require HTTP::Tiny;
+requires 'HTTP::Tiny';
-require URI::URL;
+requires 'URI::URL';
-require URI::Escape;
+requires 'URI::Escape';
+requires 'Plack::Util';

joyproxy.pm

@@ -6,13 +6,14 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 
+use Carp qw (carp);
 use Fcntl;
 use HTTP::Tiny;
 use URI::URL;
 use URI::Escape qw (uri_unescape);
 
 use Exporter qw (import);
-use version; our $VERSION = qw (1.1.0);
+use version; our $VERSION = qw (1.1.1);
 our @EXPORT_OK = qw (joyproxy joyurl);
 
 sub joyproxy ($) {
@@ -36,11 +37,11 @@ sub joyproxy ($) {
 
 			if (defined $readlen) {
 				if ($readlen != $filesize) {
-					warn "Unable to read $file readlen does not match filesize: $readlen vs $filesize";
+					carp "Unable to read $file readlen does not match filesize: $readlen vs $filesize";
 					return ('500', 'text/plain', "Unable to read file in temporary location\n");
 				}
 			} else {
-				warn "Unable to read $file: $!";
+				carp "Unable to read $file: $!";
 				return ('500', 'text/plain', "Unable to read file in temporary location: $!\n");
 			}
 
@@ -64,7 +65,7 @@ sub joyproxy ($) {
 }
 
 sub joyurl (@) {
-	my $str = shift;
+	my $str  = shift;
 	my $host = shift;
 
 	# TODO: handle error here
@@ -72,22 +73,21 @@ sub joyurl (@) {
 
 	if (length ($str) < 60) {
 		$str = '';
-	} else {
-		$str = substr $str, 14;
 	}
 
-	if ($str =~ /^img\d+\.reactor\.cc/xmsg) {
+	if ($str =~ /^joyurl=https?\:\/\/(img\d+\.reactor\.cc.+)/xmsg) {
+		my $string = $1;
 		# img1.reactor.cc/pics/post/webm/видосик.webm
-		my @url = split /\//msx, $str;
+		my @url = split /\//msx, $string;
 
 		if (($url[3] eq 'webm' || $url[3] eq 'mp4') &&
-		    ($url[4] =~ /\.webm$/xmsg || $url[4] =~ /\.mp4$/xmsg)) {
+			($url[4] =~ /\.webm$/xmsg || $url[4] =~ /\.mp4$/xmsg)) {
 			# we prefer mp4, right?, so
 			my $fname;
 			$fname = substr ($url[4], 0, -5) if (substr ($url[4], -5, 6) eq '.webm');
 			$fname = substr ($url[4], 0, -4) if (substr ($url[4], -4, 4) eq '.mp4');
 
-			$str = sprintf (
+			$string = sprintf (
 				'https://%s/joyproxy/%s/%s/%s/mp4/%s.mp4',
 				$host,
 				$url[0],
@@ -96,7 +96,7 @@ sub joyurl (@) {
 				$fname
 			);
 
-			$str = __urlencode ($str);
+			$str = __urlencode ($string);
 		} else {
 			$str = '';
 		}
@@ -130,7 +130,7 @@ sub __dlfunc($) {
 	my $url = shift;
 
 	unless (-d '/tmp/joyproxy') {
-		warn 'no /tmp/joyproxy';
+		carp 'no /tmp/joyproxy';
 
 		unless (mkdir '/tmp/joyproxy') {
 			return (undef, undef);
@@ -138,7 +138,7 @@ sub __dlfunc($) {
 	}
 
 	my @explodedurl = split /\//msx, $url;
-	my $file = $explodedurl[$#explodedurl];
+	my $file = $explodedurl[$#explodedurl]; ## no critic (Variables::RequireNegativeIndices)
 	$#explodedurl = -1; undef @explodedurl;
 	$file = '/tmp/joyproxy/' . $file;
 	$url = __urlencode ($url);

joyproxy.psgi

@@ -1,3 +1,5 @@
+#!/usr/bin/perl
+
 use 5.018;
 use strict;
 use warnings;

joyproxy.yaml

@@ -0,0 +1,17 @@
+uwsgi:
+  http-socket: 127.0.0.1:3081
+  socket-protocol: http
+  so-keepalive: 0
+  logformat: %(var.REMOTE_ADDR) %(var.REQUEST_METHOD) %(var.REQUEST_URI) %(status)
+  processes: 1
+  need-app: true
+  log-reopen: yes
+  reload-mercy: 5
+  buffer-size: 32768
+  die-on-term: true
+  pidfile: /run/joyproxy/joyproxy.pid
+  logto: /var/log/joyproxy/joyproxy.log
+  plugins: psgi
+  chdir: /var/lib/joyproxy
+  psgi: /var/lib/joyproxy/joyproxy.psgi
+  perl-local-lib: /var/lib/joyproxy/vendor_perl