Add perlcritic stuff :)

.perlcriticrc

@@ -0,0 +1,100 @@
+#!/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?

TODO

@@ -1,11 +1,17 @@
 * Реализовать проверку кэша на тухлость (Yandex.Диск зачем-то регулярно
   обновляет ссылки, период обновления я пока не выявил). Делать по приходу
   клиента.
+* Из вышележащего следует, что можно пред-генерировать практически всё. Ибо
+  оно зависит целиком и полностью от полного списка, который нам выдаёт yad и
+  по факту является статическим контентом. То есть вполне можно полностью
+  пред-генерировать все страницы и все редиректы. И по-хорошему так и надо
+  делать.
 * Не аплодить файлы, которые уже есть в диске (проверка по длине + md5 или sha).
-* Докинуть пример строки запуска uwsgi-сервера.
 * Исправить листинг каталогов, чтобы без слеша был 301-й редирект.
 * Исправить листинг файлов, чтобы по ссылке на файл отображался локальный урл,
   а при переходе на него происходил 302-й редирект.
+* Добавить режим *настоящего* проксирования, а не редиректа. До кучи. Но это
+  опционально, факультативно, так редиректы работают нормально сами по себе.
 * Добавить проверки corner-case-ов.
 * Описать утилиты.
 * Организовать многопоточную загрузку файлов на Yandex.Disk, вероятно, через

bin/yad_index_repo.pl

@@ -96,7 +96,7 @@ my %month = (
 	'09' => 'Sep',
 	'10' => 'Oct',
 	'11' => 'Nov',
-	'12' => 'Dec'
+	'12' => 'Dec',
 );
 
 foreach (@{$list}) {
@@ -135,7 +135,7 @@ foreach (@{$list}) {
 				}
 
 			} else {
-				warn "Yandex.Диск API вернуло неполные данные для $filename";
+				warn "Yandex.Диск API вернуло неполные данные для $filename\n";
 			}
 		}
 	}

bin/yad_refresh_token.pl

@@ -47,7 +47,7 @@ if (defined $refresh_token) {
 	$cache->set ('refresh_token', $token->{refresh_token}, 'never');
 	$cache->set ('access_token', $token->{access_token}, $token->{expires_in} - 60);
 } else {
-	die "В локальной базе нет refresh token, возможно, для начала следует запустить yad_get_token.pl";
+	die "В локальной базе нет refresh token, возможно, для начала следует запустить yad_get_token.pl\n";
 }
 
 exit 0;

bin/yad_show_token.pl

@@ -39,8 +39,7 @@ my $access_token = $cache->get ('access_token');
 if (defined $refresh_token && defined $access_token) {
 	printf "access_token:\n%s\n\nrefresh_token:\n%s\n", $access_token, $refresh_token;
 } else {
-	say "Что-то пошло не так, токены не нашлись, попробуйте их пере-получить через скрипт yad_get_token.pl";
-	exit 1;
+	die "Что-то пошло не так, токены не нашлись, попробуйте их пере-получить через скрипт yad_get_token.pl\n";
 }
 
 exit 0;

bin/yad_upload_dir.pl

@@ -70,7 +70,7 @@ sub wanted {
 
 		unless (defined $targets{$target}) {
 			unless ($disk->createFolder (-path => $target, -recursive => 1)) {
-				die "Невозможно создать каталог $c->{remote_dir} на Yandex.Диске";
+				die "Невозможно создать каталог $c->{remote_dir} на Yandex.Диске\n";
 			}
 
 			$targets{$target} = 1;
@@ -86,4 +86,5 @@ sub wanted {
 	}
 
 	sleep 3;
+	return;
 }

lib/YadProxy.pm

@@ -96,9 +96,9 @@ sub DirList {
 		$index_of = '/' . $index_of;
 	}
 
-	push @output, "<html>";
+	push @output, '<html>';
 	push @output, sprintf '<head><title>Index of %s/</title></head>', $index_of;
-	push @output, "<body>";
+	push @output, '<body>';
 	push @output, sprintf '<h1>Index of %s/</h1><hr><pre><a href="../">../</a>', $index_of;
 
 	# попробуем отловить все каталоги, начинающиеся с запрошенного пути
@@ -187,8 +187,8 @@ sub DirList {
 		}
 	}
 
-	push @output, "</pre><hr></body>";
-	push @output, "</html>";
+	push @output, '</pre><hr></body>';
+	push @output, '</html>';
 	return ('200', 'text/html', join "\n", @output);
 }
 

lib/YadProxy/Conf.pm

@@ -22,16 +22,16 @@ sub LoadConf {
 	my $readlen = read $CH, $json, $len;
 
 	unless ($readlen) {
-		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
+		close $CH;
 		die "[FATAL] Unable to read $c: $OS_ERROR\n";
 	}
 
 	if ($readlen != $len) {
-		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
+		close $CH;
 		die "[FATAL] File $c is $len bytes on disk, but we read only $readlen bytes\n";
 	}
 
-	close $CH;                                       ## no critic (InputOutput::RequireCheckedSyscalls
+	close $CH;
 	my $j = JSON::XS->new->utf8->relaxed;
 	return $j->decode ($json);
 }

lib/YadProxy/Lib.pm

@@ -33,7 +33,7 @@ sub GetAccessToken {
 		my $refresh_token = $cache->get ('refresh_token');
 
 		unless (defined $refresh_token) {
-			$log->fatal ("No refresh_token found in base, please, register yaproxy application");
+			$log->fatal ('No refresh_token found in base, please, register yaproxy application');
 			exit 1;
 		}
 
@@ -66,7 +66,7 @@ sub RefreshAccessToken {
 	if (defined $token->{access_token}) {
 		return $token;
 	} else {
-		$log->fatal ("[FATAL] Unable to refresh access_token");
+		$log->fatal ('[FATAL] Unable to refresh access_token');
 		exit 1;
 	}
 }

test/yad_file_info.pl

@@ -34,7 +34,7 @@ if ($c->{remote_dir} && $c->{remote_dir} ne '') {
 }
 
 my $disk = Yandex::Disk->new ( -token => GetAccessToken );
-say Dumper $disk->fileInfo ( -path => sprintf ("%s/%s", $remote_dir, $file));
+say Dumper $disk->fileInfo ( -path => sprintf ('%s/%s', $remote_dir, $file));
 
 __END__
 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

test/yad_mkdir.pl

@@ -32,7 +32,7 @@ if ($c->{remote_dir} && $c->{remote_dir} ne '') {
 	$remote_dir = $c->{remote_dir};
 
 	$disk->createFolder (-path => $remote_dir, -recursive => 1) or do {
-		die "Невозможно создать каталог $c->{remote_dir} на Yandex.Диске";
+		croak "Невозможно создать каталог $c->{remote_dir} на Yandex.Диске";
 	};
 }
 

test/yad_upload_file.pl

@@ -39,7 +39,7 @@ if ($c->{remote_dir} && $c->{remote_dir} ne '') {
 		-path => $remote_dir,
 		-recursive => 1
 	) or do {
-		die "Невозможно создать каталог $c->{remote_dir} на Yandex.Диске";
+		croak "Невозможно создать каталог $c->{remote_dir} на Yandex.Диске";
 	};
 }
 
@@ -47,7 +47,7 @@ $disk->uploadFile (
 	-file => $file,
 	-remote_path => $remote_dir,
 	-overwrite => 1
-) or die "Не могу зааплодить файл в каталог $remote_dir на Yandex.Диске";
+) or croak "Не могу зааплодить файл в каталог $remote_dir на Yandex.Диске";
 
 say Dumper $disk->listFiles (-path =>$remote_dir);
 

yadproxy.psgi

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