Pin versions in cpanfile, fix coding style and cleanup a bit

README.md

@@ -85,19 +85,19 @@ Additional JSON-formatted metadata if required for buildinfo module to work. An
 }
 ```
 
-But this data intended to help in package build script that prepares build environment, runs SlackBuilds, upload 
+But this data intended to help in package build script that prepares build environment, runs SlackBuilds, upload files
-files to repo and kicks metadata generation process.
+to repo and kicks metadata generation process.
 
 All metadata required and generated by this application very-very close to one found in AlienBob's
 [repositories](http://www.slackware.com/~alien/slackbuilds/), except no changelogs and rss are generated.
 
 ## Installation
 
-In order to run this application, you need to "bootstrap" it - download and build
+In order to run this application, you need to "bootstrap" it - download and build all required dependencies and
-all required dependencies and libraries.
+libraries.
 
-You'll need "Development Tools" or similar group of packages, perl, perl-devel,
+You'll need "Development Tools" or similar group of packages, perl, perl-devel, perl-local-lib, perl-app-cpanm,
-perl-local-lib, perl-app-cpanm, zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make.
+zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make.
 
 After installng required dependencies it is possible to run:
 
@@ -107,6 +107,8 @@ bash bootstrap.sh
 
 and all libraries should be downloaded, built, tested and installed.
 
+This application is tested and runs okay on Slackware64-14.2.
+
 ## How to run this?
 
 Via [uWSGI](https://github.com/unbit/uwsgi).
@@ -137,9 +139,14 @@ exec sudo -u apache -g apache /usr/bin/uwsgi \
 
 ```
 
-At least i use uwsgi for this. Starman suits well too and should work without any problems. You can also try
+At least i use uwsgi-2.0.19 for this. Starman suits well too and should work without any problems. You can also try
 [Nginx UNIT](https://unit.nginx.org/), but it was totally not tested.
 
+As mentioned above this application tested on Slackware Linux 14.2 for x86_64. At least you'll need perl-AnyEvent,
+perl-Coro, perl-Devel-StackTrace, perl-local-lib, cpanminus, perl-common-sense, perl-Guard, perl-EV,
+perl-Canary-Stability, perl-event. You can get SlackBuilds for them on [SBo](https://slackbuilds.org/repository/14.2/).
+After installing all these packages you'll be able to bootatrap and run slackmetarep.
+
 ## How to contribute?
 
 Got something about this project? Make PR.
@@ -147,8 +154,8 @@ Got something about this project? Make PR.
 ## Who should i thank?
 
 Slackware mainatiners for their continous labour. Notably [AlienBob](https://docs.slackware.com/wiki:user:alienbob) and
-SBo team.
+[SBo team](https://slackbuilds.org/contributors/).
 
 ## What is missing here?
 
-At least proper documentaion of metadata format generated by this particular application.
+At least proper documentaion of metadata format generated by this particular application. :)

Slackmetarep/Buildinfo.pm

@@ -1,84 +1,95 @@
 package Slackmetarep::Buildinfo;
 
+use 5.018;
 use strict;
 use warnings;
-use vars qw/$VERSION/;
+use utf8;
-use English qw( -no_match_vars );
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+
 use Carp;
-
+use Encode qw (encode);
 use JSON::XS;
-use Slackmetarep::Conf qw(loadConf);
 
-use Exporter qw(import);
+use Slackmetarep::Conf qw (LoadConf);
-our @EXPORT_OK = qw(buildinfo);
 
-$VERSION = '1.0';
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (BuildInfo);
 
-my $c = loadConf();
+my $c = LoadConf ();
 
-sub buildinfo ($) {
+sub BuildInfo ($) {
 	my $repo = shift;
 	my ($status, $content, $msg) = ('400', 'text/plain', "Bad Request?\n");
 
-	return ($status, $content, $msg) unless ($repo =~ /\//xmsg);
+	# Request cosists of repo/package, so it must contain slash
+	unless ($repo =~ /\//xmsg) {
+		return $status, $content, $msg;
+	}
 
-	my ($config, $package) = split(/\//xms, $repo);
+	my ($config, $package) = split /\//xms, $repo;
 
-	unless (defined($c->{buildinfo}->{$config})) {
+	unless (defined $c->{buildinfo}->{$config}) {
 		$msg = "Config repo $config is not defined in config.\n";
-		return ($status, $content, $msg);
+		return $status, $content, $msg;
 	}
 
 	open (my $jhandle, '<', $c->{buildinfo}->{$config}) or do {
-		$status = '500';
 		$msg = "Unable to open $c->{buildinfo}->{$config}; $OS_ERROR\n";
 		carp '[FATA] ' . $msg;
-		return ($status, $content, $msg);
+		return '500', $content, $msg;
 	};
 
-	my $len = (stat($c->{buildinfo}->{$config}))[7];
+	my $len = (stat $c->{buildinfo}->{$config})[7];
 	my $json;
-	my $readlen = read ($jhandle, $json, $len);
+	# Use binmode in order to get read bytes (not chars!) from read()
+	binmode $jhandle;
+	my $readlen = read $jhandle, $json, $len;
 	close $jhandle; ## no critic (InputOutput::RequireCheckedSyscalls
 
-	unless (defined($readlen)) {
+	unless (defined $readlen) {
-		$status = '500';
 		$msg = "Unable to read $c->{buildinfo}->{$config}: $OS_ERROR";
 		carp '[FATA] ' . $msg;
-		return ($status, $content, $msg);
+		return '500', $content, $msg;
 	}
 
 	if ($len != $readlen) {
-		$status = '500';
 		$msg = "Size of $c->{buildinfo}->{$config} $len bytes but actually read $readlen bytes";
 		carp '[FATA] ' . $msg;
-		return ('500', $content, "Unable to read $c->{buildinfo}->{$config}\n");
+		return '500', $content, "Unable to read $c->{buildinfo}->{$config}\n";
 	}
 
-	my $j = eval { decode_json($json) } or do {
+	# Make sure that we have utf-8 text here
-		$status = '500';
+	$json = encode 'UTF-8', $json;
+
+	# Use relaxed decoder, we don't want to mess with human errors, right?
+	my $j = eval {
+		my $jq = JSON::XS->new->utf8->relaxed;
+		$jq->decode ($json);
+	} or do {
 		$msg = "Error during decoding $c->{buildinfo}->{$config}; $EVAL_ERROR\n";
 		carp '[FATA] ' . $msg;
-		return ($status, $content, $msg);
+		return '500', $content, $msg;
 	};
 
-	unless (defined($j->{$package})) {
+	$json = '';
+
+	unless (defined $j->{$package}) {
 		$msg = "$package is not defined in config for $config.\n";
 		carp '[ERRO] ' . $msg;
-		return ($status, $content, $msg);
+		return $status, $content, $msg;
 	}
 
-	$json = JSON::XS->new->pretty->canonical->indent(1)->encode($j->{$package}) or do {
+	# Use small indentation, just 1 space and default formatting
-		$status = '500';
+	my $jq = JSON::XS->new->pretty->canonical->indent (1);
+	$msg = $jq->encode ($j->{$package}) or do {
 		$msg = "Unable to encode json.\n";
 		carp '[ERRO] ' . $msg;
-		return ($status, $content, $msg);
+		return '500', $content, $msg;
 	};
 
-	$status = '200';
+	return '200', 'application/json', $msg;
-	$content = 'application/json';
-	$msg = $json;
-	return ($status, $content, $msg);
 }
 
 1;

Slackmetarep/Conf.pm

@@ -1,41 +1,50 @@
 package Slackmetarep::Conf;
-# loads config
+# Loads json formatted config
 
 use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
+use open qw (:std :utf8);
-use English qw( -no_match_vars );
+use English qw ( -no_match_vars );
-
+use Encode qw (encode);
-use vars qw/$VERSION/;
 use JSON::XS;
 
-use Exporter qw(import);
+use version; our $VERSION = qw (1.0);
-our @EXPORT_OK = qw(loadConf);
+use Exporter qw (import);
+our @EXPORT_OK = qw (LoadConf);
 
-$VERSION = '1.0';
+sub LoadConf {
+	my $file = 'data/config.json';
+	open my $FILEHANDLE, '<', $file || die "[FATA] No conf at $file: $OS_ERROR\n";
 
-sub loadConf {
+	# Use binmode in order to get amount of read bytes (not chars!) from read()
-	my $c = 'data/config.json';
+	binmode $FILEHANDLE;
-	open my $CH, '<', $c || die "[FATA] No conf at $c: $OS_ERROR\n";
+	my $len = (stat $file) [7];
-	my $len = (stat ($c)) [7];
 	my $json;
-	my $readlen = read $CH, $json, $len;
+	my $readlen = read $FILEHANDLE, $json, $len;
+	$json = encode 'UTF-8', $json;
 
-	unless ($readlen) {
+	unless (defined $readlen) {
-		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
+		close $FILEHANDLE;                                   ## no critic (InputOutput::RequireCheckedSyscalls
-		die "[FATA] Unable to read $c: $OS_ERROR\n";
+		die "[FATA] Unable to read $file: $OS_ERROR\n";
 	}
 
 	if ($readlen != $len) {
-		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
+		close $FILEHANDLE;                                   ## no critic (InputOutput::RequireCheckedSyscalls
-		die "[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n";
+		die "[FATA] File $file is $len bytes on disk, but we read only $readlen bytes\n";
 	}
 
-	close $CH;                                       ## no critic (InputOutput::RequireCheckedSyscalls
+	close $FILEHANDLE;                                       ## no critic (InputOutput::RequireCheckedSyscalls
+
 	my $j = JSON::XS->new->utf8->relaxed;
-	return $j->decode ($json);
+	my $config = eval { $j->decode ($json); };
+
+	unless (defined $config) {
+		die "[FATA] File $file does not contain a valid json data: $EVAL_ERROR\n";
+	}
+
+	return $config;
 }
 
 1;

Slackmetarep/Metagen.pm

@@ -18,72 +18,89 @@
 
 package Slackmetarep::Metagen;
 
+use 5.018;
 use warnings;
 use strict;
 
 use utf8;
-use open qw(:std :utf8);
+use open qw (:std :utf8);
-use vars qw/$VERSION/;
+use English qw ( -no_match_vars );
-use English qw( -no_match_vars );
 
+use bytes ();
 use Carp;
 use Fcntl;
-use Compress::Raw::Bzip2 qw(BZ_RUN_OK BZ_STREAM_END);
+use Compress::Raw::Bzip2 qw (BZ_RUN_OK BZ_STREAM_END);
 use Compress::Raw::Zlib;
-use POSIX qw(strftime);
+use POSIX qw (strftime);
 
-use Slackmetarep::Conf qw(loadConf);
+use Slackmetarep::Conf qw (LoadConf);
 
-use Exporter qw(import);
+use version; our $VERSION = qw (1.0);
-our @EXPORT_OK = qw(metagen);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Metagen);
 
-$VERSION = '1.0';
+sub Metagen ($);
+sub __prettyFormattedDate ();        # generates current date in pretty format
+sub __trim ($);
+sub __readFile ($);
+sub __dirList ($);
+sub __writeFile (@);
+sub __bzip2Data ($);
+sub __gzipData ($);
 
-sub metagen($);
+sub Metagen ($) {
-sub __pdate;        # generates current date in pretty format
-sub __trim($);
-sub __readfile($);
-sub __dirlist($);
-sub __writefile(@);
-sub __bzdata($);
-sub __gzdata($);
-
-sub metagen ($) {
 	my $dir = shift;
-	my $c = loadConf();
+	my $c = LoadConf ();
 	$dir = $c->{metagen}->{$dir};
 
 	unless (defined $dir || ($dir eq '')) {
-		return ('400', 'text/plain', "No such repository\n");
+		return '400', 'text/plain', "No such repository\n";
+	}
+
+	my $dirlist = __dirList ($dir);
+
+	if (defined $dirlist->{error}) {
+		return '500', 'text/plain', $dirlist->{error};
 	}
 
-	my $dirlist = __dirlist ($dir);
-	return ('500', 'text/plain', $dirlist->{error}) if (defined $dirlist->{error});
 	my @filelist = @{$dirlist->{dir}};
 	$dirlist = undef;
 
-	# manifest
+	# Generate Manifest.bz2
 	my $buf = '';
 
 	foreach my $filename (@filelist) {
 		if ($filename =~ /\.lst/xmsg) {
-			my $file = __readfile("$dir/$filename");
+			my $file = __readFile ("$dir/$filename");
-			return ('500', 'text/plain', $file->{error}) if (defined $file->{'error'});
+
+			if (defined $file->{'error'}) {
+				return '500', 'text/plain', $file->{error};
+			}
+
 			$buf .= __trim $file->{data};
 			$buf .= "\n\n\n";
-			$file->{data} = ''; $file = undef;
+
+			$file->{data} = '';
+			$file = undef;
 		}
 	}
 
-	my $bzdata = __bzdata (\$buf);
+	my $bzippedData = __bzip2Data (\$buf);
-	return ('500', 'text/plain', $bzdata->{error}) if (defined $bzdata->{error});
 
-	my $manifest = __writefile ("$dir/MANIFEST.bz2", \$bzdata->{data});
+	if (defined $bzippedData->{error}) {
-	return ('500', 'text/plain', $manifest->{error}) if (defined $manifest->{error});
+		return '500', 'text/plain', $bzippedData->{error};
+	}
 
-	$bzdata->{data} = ''; $bzdata = undef;
+	my $manifest_bz2 = __writeFile ("$dir/MANIFEST.bz2", \$bzippedData->{data});
 
-	# checksums
+	if (defined $manifest_bz2->{error}) {
+		return '500', 'text/plain', $manifest_bz2->{error};
+	}
+
+	$bzippedData->{data} = '';
+	$bzippedData = undef;
+
+	# Generate CHECKSUMS.md5 and CHECKSUMS.md5.gz
 	$buf = << 'MSG';
 These are the MD5 message digests for the files in this directory.
 If you want to test your files, use 'md5sum' and compare the values to
@@ -104,50 +121,88 @@ MSG
 		next if ($filename =~ /CHECKSUMS.md5.gz$/xmsg);
 
 		if ($filename =~ /\.md5/xmsg) {
-			my $file = __readfile("$dir/$filename");
+			my $file = __readFile ("$dir/$filename");
-			return ('500', 'text/plain', $file->{error}) if (defined $file->{'error'});
+
+			if (defined $file->{'error'}) {
+				return '500', 'text/plain', $file->{error};
+			}
+
 			$buf .= $file->{data};
-			$file->{data} = ''; $file = undef;
+
+			$file->{data} = '';
+			$file = undef;
 		}
 	}
 
-	my $checksum = __writefile ("$dir/CHECKSUMS.md5", \$buf);
+	my $checksum_md5_file = __writeFile ("$dir/CHECKSUMS.md5", \$buf);
-	return ('500', 'text/plain', $checksum->{error}) if (defined $checksum->{error});
+
+	if (defined $checksum_md5_file->{error}) {
+		return '500', 'text/plain', $checksum_md5_file->{error};
+	}
+
+	# Gzip CHECKSUM.md5 contents
+	my $gzippedBuf = __gzipData (\$buf);
+
+	if (defined $gzippedBuf->{error}) {
+		return '500', 'text/plain', $gzippedBuf->{error};
+	}
 
-	my $gzipchecksum = __gzdata(\$buf);
-	return ('500', 'text/plain', $gzipchecksum->{error}) if (defined $gzipchecksum->{error});
 	$buf = '';
 
-	my $checksumgz = __writefile ("$dir/CHECKSUMS.md5.gz", \$gzipchecksum->{data});
+	my $checksum_md5_gz_file = __writeFile ("$dir/CHECKSUMS.md5.gz", \$gzippedBuf->{data});
-	return ('500', 'text/plain', $checksumgz->{error}) if (defined $checksumgz->{error});
-	$gzipchecksum->{data} = ''; $gzipchecksum = undef;
 
-	# packages
+	if (defined $checksum_md5_gz_file->{error}) {
-	$buf = sprintf "PACKAGES.TXT;  %s\n\n\n", __pdate;
+		return '500', 'text/plain', $checksum_md5_gz_file->{error};
+	}
 
-	foreach my $filename (@filelist) {
+	$gzippedBuf->{data} = '';
+	$gzippedBuf = undef;
+
+	# Generate PACKAGES.txt and PACKAGES.txt.gz
+	$buf = sprintf "PACKAGES.TXT;  %s\n\n\n", __prettyFormattedDate ();
+
+	# At this point we have no need to preserve @filelist, we rather want to empty it
+	while (my $filename = shift @filelist) {
 		if ($filename =~ /\.meta/xmsg) {
-			my $file = __readfile("$dir/$filename");
+			my $file = __readFile ("$dir/$filename");
-			return ('500', 'text/plain', $file->{error}) if (defined $file->{'error'});
+
+			if (defined $file->{'error'}) {
+				return '500', 'text/plain', $file->{error};
+			}
+
 			$buf .= __trim ($file->{data});
 			$buf .= "\n\n";
-			$file->{data} = ''; $file = undef;
+
+			$file->{data} = '';
+			$file = undef;
 		}
 	}
 
-	my $packages = __writefile ("$dir/PACKAGES.TXT", \$buf);
+	my $packages_txt_file = __writeFile ("$dir/PACKAGES.TXT", \$buf);
-	return ('500', 'text/plain', $packages->{error}) if (defined $packages->{error});
+
+	if (defined $packages_txt_file->{error}) {
+		return '500', 'text/plain', $packages_txt_file->{error};
+	}
+
+	$gzippedBuf = __gzipData (\$buf);
+
+	if (defined $gzippedBuf->{error}) {
+		return '500', 'text/plain', $gzippedBuf->{error};
+	}
 
-	my $gzippackages = __gzdata(\$buf);
-	return ('500', 'text/plain', $gzippackages->{error}) if (defined $gzippackages->{error});
 	$buf = '';
 
-	my $packagesgz = __writefile ("$dir/PACKAGES.TXT.gz", \$gzippackages->{data});
+	my $packages_txt_gz_file = __writeFile ("$dir/PACKAGES.TXT.gz", \$gzippedBuf->{data});
-	return ('500', 'text/plain', $packagesgz->{error}) if (defined $packagesgz->{error});
-	$gzippackages->{data} = ''; $gzippackages = undef;
 
-	# filelist
+	if (defined $packages_txt_gz_file->{error}) {
-	$buf = __pdate;
+		return ('500', 'text/plain', $packages_txt_gz_file->{error});
+	}
+
+	$gzippedBuf->{data} = '';
+	$gzippedBuf = undef;
+
+	# Generate FILELIST.txt
+	$buf = __prettyFormattedDate;
 	$buf .= "\n\n";
 	$buf .= << 'BUFFER';
 Here is the file list for this directory,
@@ -158,17 +213,19 @@ refresh the mirror.
 
 BUFFER
 
-	# dir listing is not actual, so we need to re-read it
+	$dirlist = __dirList ($dir);
-	$#filelist = -1;
+
-	$dirlist = __dirlist ($dir);
+	if (defined $dirlist->{error}) {
-	return ('500', 'text/plain', $dirlist->{error}) if (defined $dirlist->{error});
+		return '500', 'text/plain', $dirlist->{error};
+	}
+
 	@filelist = @{$dirlist->{dir}};
 	$dirlist = undef;
 
-	while (my $file = shift (@filelist)) {
+	while (my $file = shift @filelist) {
-		my $filename = sprintf ('%s/%s', $dir, $file);
+		my $filename = sprintf '%s/%s', $dir, $file;
 		my @stat = stat $filename;
-		my @date = localtime ($stat[10]);
+		my @date = localtime $stat[10];
 
 		$buf .= sprintf (
 			"-rw-r--r-- %d root root % 8d %04d-%02d-%02d %02d:%02d ./%s\n",
@@ -184,13 +241,18 @@ BUFFER
 	}
 
 	$#filelist = -1;
-	my $filelist = __writefile ("$dir/FILELIST.TXT", \$buf);
+	my $filelist = __writeFile ("$dir/FILELIST.TXT", \$buf);
-	return ('500', 'text/plain', $filelist->{error}) if (defined $filelist->{error});
+
+	if (defined $filelist->{error}) {
+		return '500', 'text/plain', $filelist->{error};
+	}
+
 	$buf = '';
-	return  ('200', 'text/plain', "Done\n");
+
+	return '200', 'text/plain', "Done\n";
 }
 
-sub __pdate {
+sub __prettyFormattedDate () {
 	my @time = gmtime(time);
 	my @DAYOFWEEK = qw(Sun Mon Tue Wed Thu Fri Sat);
 	my @MONTH = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Nov Dec);
@@ -201,17 +263,17 @@ sub __trim ($) {
 	my $str = shift;
 
 	while (substr ($str, 0, 1) =~ /^\s$/xms) {
-		$str = substr ($str, 1);
+		$str = substr $str, 1;
 	}
 
 	while (substr ($str, -1, 1) =~ /^\s$/xms) {
-		chop ($str);
+		chop $str;
 	}
 
 	return $str;
 }
 
-sub __readfile ($) {
+sub __readFile ($) {
 	my $file = shift;
 	my $ret;
 
@@ -225,7 +287,7 @@ sub __readfile ($) {
 	binmode $FILEHANDLE;
 	my $buf;
 	my $len = (stat $file)[7];
-	my $readlen = read ($FILEHANDLE, $buf, $len);
+	my $readlen = read $FILEHANDLE, $buf, $len;
 	close $FILEHANDLE; ## no critic (InputOutput::RequireCheckedSyscalls)
 
 	unless (defined $readlen) {
@@ -246,7 +308,7 @@ sub __readfile ($) {
 	return $ret;
 }
 
-sub __writefile (@) {
+sub __writeFile (@) {
 	my $file = shift;
 	my $dataref = shift;
 	my $ret;
@@ -260,10 +322,8 @@ sub __writefile (@) {
 
 	binmode $FILEHANDLE;
 
-	use bytes;
+	my $len = bytes::length ${$dataref};
-	my $len = length ${$dataref};
+	my $writelen = syswrite $FILEHANDLE, ${$dataref}, $len;
-	no bytes;
-	my $writelen = syswrite ($FILEHANDLE, ${$dataref}, $len);
 	close $FILEHANDLE; ## no critic (InputOutput::RequireCheckedSyscalls)
 
 	unless (defined $writelen) {
@@ -284,7 +344,7 @@ sub __writefile (@) {
 	return $ret;
 }
 
-sub __dirlist ($) {
+sub __dirList ($) {
 	my $dir = shift;
 	my $res;
 	my @files;
@@ -307,10 +367,9 @@ sub __dirlist ($) {
 	return $res;
 }
 
-sub __bzdata ($) {
+sub __bzip2Data ($) {
 	my $databufref = shift;
 	my $ret;
-	my $bzdata;
 	my $bz = Compress::Raw::Bzip2->new (1, 9, 0);
 
 	unless (defined $bz) {
@@ -320,35 +379,36 @@ sub __bzdata ($) {
 		return $ret;
 	}
 
-	if ($bz->bzdeflate(${$databufref}, $bzdata) != BZ_RUN_OK) {
+	if ($bz->bzdeflate (${$databufref}, $ret->{data}) != BZ_RUN_OK) {
 		my $msg = 'Unable to perofrm bzip2 compression';
 		carp "[FATA] $msg";
+		delete ($ret->{data});
 		$ret->{error} = $msg;
 		return $ret;
 	}
 
-	if ($bz->bzflush($bzdata) != BZ_RUN_OK) {
+	if ($bz->bzflush ($ret->{data}) != BZ_RUN_OK) {
 		my $msg = 'Unable to flush bz buffer';
 		carp "[FATA] $msg";
+		delete ($ret->{data});
 		$ret->{error} = $msg;
 		return $ret;
 	}
 
-	if ($bz->bzclose($bzdata) != BZ_STREAM_END) {
+	if ($bz->bzclose ($ret->{data}) != BZ_STREAM_END) {
 		my $msg = 'Unable to flush and close bz buffer';
 		carp "[FATA] $msg";
+		delete ($ret->{data});
 		$ret->{error} = $msg;
 		return $ret;
 	}
 
-	$ret->{data} = $bzdata;
 	return $ret;
 }
 
-sub __gzdata ($) {
+sub __gzipData ($) {
 	my $databufref = shift;
 	my $ret;
-	my $gzdata;
 
 	my $gz = Compress::Raw::Zlib::Deflate->new (
 		-Level => Z_BEST_COMPRESSION,
@@ -364,21 +424,22 @@ sub __gzdata ($) {
 		return $ret;
 	}
 
-	if ($gz->deflate(${$databufref}, $gzdata) != Z_OK) {
+	if ($gz->deflate (${$databufref}, $ret->{data}) != Z_OK) {
 		my $msg = 'Unable to deflate';
 		carp "[FATA] $msg";
+		delete ($ret->{data});
 		$ret->{error} = $msg;
 		return $ret;
 	}
 
-	if ($gz->flush($gzdata) != Z_OK) {
+	if ($gz->flush ($ret->{data}) != Z_OK) {
 		my $msg = 'Unable to flush gz object';
 		carp "[FATA] $msg";
+		delete ($ret->{data});
 		$ret->{error} = $msg;
 		return $ret;
 	}
 
-	$ret->{data} = $gzdata;
 	return $ret;
 }
 

Slackmetarep/Upload.pm

@@ -1,22 +1,22 @@
 package Slackmetarep::Upload;
 
+use 5.018;
 use strict;
 use warnings;
 use vars qw/$VERSION/;
-use English qw( -no_match_vars );
+use English qw ( -no_match_vars );
 use Carp;
 
 use Fcntl;
-use Slackmetarep::Conf qw(loadConf);
+use Slackmetarep::Conf qw (LoadConf);
 
-use Exporter qw(import);
+use version; our $VERSION = qw (1.0);
-our @EXPORT_OK = qw(upload);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Upload);
 
-$VERSION = '1.0';
+my $c = LoadConf ();
 
-my $c = loadConf ();
+sub Upload {
-
-sub upload {
 	my $input = shift;        # file descriptor with data being uploaded
 	my $len = shift;          # expected data length (from client)
 	my $name = shift;         # upload "dir" and filename
@@ -26,25 +26,30 @@ sub upload {
 	return ($status, $content, "No name supplied.\n") unless (defined $name);
 
 	my $d;
-	($d, $name) = split (/\//xms, $name, 2);
+	($d, $name) = split /\//xms, $name, 2;
 
-	return ($status, $content, "Name does not match pattern.\n") unless ($name =~ /^[[:alnum:]_\-\+\.]+$/xmsg);
+	unless ($name =~ /^[[:alnum:]_\-\+\.]+$/xmsg) {
+		return $status, $content, "Name does not match pattern.\n";
+	}
 
 	my $match;
 
-	foreach my $uploaddir (keys(%{$c->{upload}->{dir}})) {
+	foreach my $uploaddir (keys %{$c->{upload}->{dir}}) {
 		if ($d eq $uploaddir) {
 			$match = 1;
 			last;
 		}
 	}
 
-	return ($status, $content, "Incorrect destination dir.\n") unless $match; # incorrect destination in url
+	# Incorrect destination in url
+	unless ($match) {
+		return $status, $content, "Incorrect destination dir.\n";
+	}
 
-	$name = sprintf('%s/%s', $c->{upload}->{dir}->{$d}, $name);
+	$name = sprintf '%s/%s', $c->{upload}->{dir}->{$d}, $name;
 
 	if ($len > 0) {
-		if (sysopen (my $FH, $name, O_CREAT|O_TRUNC|O_WRONLY)) {
+		if (sysopen my $FH, $name, O_CREAT|O_TRUNC|O_WRONLY) {
 			my $buf;
 			my $readlen = 0;
 			my $totalread = 0;
@@ -55,28 +60,33 @@ sub upload {
 			}
 
 			do {
-				$readlen = $input->read($buf, $buflen);
+				$readlen = $input->read ($buf, $buflen);
 
 				my $written = syswrite $FH, $buf, $readlen;
 
-				unless (defined($written)) { # out of space?
+				# Not enough free space?
+				unless (defined $written) {
 					close $FH; ## no critic (InputOutput::RequireCheckedSyscalls)
 					unlink $name;
+					$buf = '';
 					carp "[FATA] Unable to write to $name: $OS_ERROR";
-					return ('500', $content, "An error has occured during upload: $OS_ERROR\n");
+					return '500', $content, "An error has occured during upload: $OS_ERROR\n";
 				}
 
+				# Other error
 				if ($readlen != $written) {
 					close $FH; ## no critic (InputOutput::RequireCheckedSyscalls)
 					unlink $name;
+					$buf = '';
 					carp "[FATA] Must write $readlen bytes, but actualy wrote $written bytes to $name";
-					return ('500', $content, "An error has occured during upload: $OS_ERROR\n");
+					return '500', $content, "An error has occured during upload: $OS_ERROR\n";
 				}
 
 				$totalread += $readlen;
 			} while ($readlen == $buflen);
 
 			close $FH; ## no critic (InputOutput::RequireCheckedSyscalls)
+			$buf = '';
 
 			if ($totalread != $len) {
 				($content, $msg) = ($content, "Content-Length does not match amount of recieved bytes.\n");
@@ -91,7 +101,7 @@ sub upload {
 		$msg = "Incorrect Content-Length\n";
 	}
 
-	return ($status, $content, $msg);
+	return $status, $content, $msg;
 }
 
 1;

confcheck.pl

@@ -4,17 +4,20 @@ use 5.018;
 use strict;
 use warnings;
 use utf8;
-use open qw(:std :utf8);
+use open qw (:std :utf8);
-use English qw( -no_match_vars );
+
+use English qw ( -no_match_vars );
 use JSON::XS;
-use lib qw(./vendor_perl ./vendor_perl/lib/perl5);
+
+use lib qw (./vendor_perl ./vendor_perl/lib/perl5);
 
 use Slackmetarep::Conf;
 
-use version; our $VERSION = qv(1.0);
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
 
-my $CONF = loadConf();
+my $CONF = LoadConf ();
-my $j = JSON::XS->new->pretty->canonical->indent(1);
+my $j = JSON::XS->new->pretty->canonical->indent (1);
 say $j->encode ($CONF);                              ## no critic (InputOutput::RequireCheckedSyscalls)
 
 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

cpanfile

@@ -1,8 +1,12 @@
-requires 'Compress::Raw::Bzip2';
+## no critic (Modules::RequireVersionVar,Modules::RequireExplicitPackage,Modules::RequireEndWithOne)
-requires 'Compress::Raw::Zlib';
+## no critic (TestingAndDebugging::RequireUseStrict,TestingAndDebugging::RequireUseWarnings)
-requires 'Exporter';
+requires 'Compress::Raw::Bzip2', '==2.068';
-requires 'Fcntl';
+requires 'Compress::Raw::Zlib',  '==2.068';
-requires 'JSON::XS';
+requires 'Exporter',             '==5.72';
-requires 'POSIX';
+requires 'Fcntl',                '==1.13';
-requires 'Plack::Util';
+requires 'JSON::XS',             '==4.03';
-requires 'local::lib';
+requires 'POSIX',                '==1.53_01';
+requires 'Plack',                '==1.0047';
+# is a part of Plack distribution, unversioned
+requires 'Plack::Util',          '0';
+requires 'local::lib',           '==2.000024';

slackmetarep.psgi

@@ -1,22 +1,28 @@
 ## no critic (Modules::RequireExplicitPackage)
+use 5.018;
 use strict;
 use warnings;
+use utf8;
+use open qw (:std :utf8);
 
-# my plugins
+# Application modules
-use lib qw(. ./vendor_perl ./vendor_perl/lib/perl5);
+use lib qw (. ./vendor_perl ./vendor_perl/lib/perl5);
-use Slackmetarep::Conf qw(loadConf);
+use Slackmetarep::Conf qw (LoadConf);
-use Slackmetarep::Upload qw(upload);
+use Slackmetarep::Upload qw (Upload);
-use Slackmetarep::Metagen qw(metagen);
+use Slackmetarep::Metagen qw (Metagen);
-use Slackmetarep::Buildinfo qw(buildinfo);
+use Slackmetarep::Buildinfo qw (BuildInfo);
 
-use version; our $VERSION = qv(1.0);
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
 
-my $CONF = loadConf ();
+my $CONF = LoadConf ();
 
-if ($CONF->{api}->{prefix} eq '/') { $CONF->{api}->{prefix} = ''; }
 my $prefix = $CONF->{api}->{prefix};
 
-                 # that is not module.
+if ($CONF->{api}->{prefix} eq '/') {
+	$prefix = '';
+}
+
 my $app = sub { ## no critic (Modules::RequireEndWithOne)
 	my $env = shift;
 
@@ -31,7 +37,7 @@ my $app = sub { ## no critic (Modules::RequireEndWithOne)
 		if (defined($env->{HTTP_AUTH}) && ($env->{HTTP_AUTH} eq $CONF->{upload}->{auth})) {
 			if (($upload !~ /\.\./xmsg) && ($upload =~ /^[_\-\+\/\.[:alnum:]]+$/xmsg)) {
 				if (defined($env->{CONTENT_LENGTH}) && ($env->{CONTENT_LENGTH} > 0)) {
-					($status, $content, $msg) = upload ($env->{'psgi.input'}, $env->{CONTENT_LENGTH}, $upload);
+					($status, $content, $msg) = Upload ($env->{'psgi.input'}, $env->{CONTENT_LENGTH}, $upload);
 				}
 			} else {
 				$msg = "Something wrong with upload path.\n";
@@ -41,11 +47,11 @@ my $app = sub { ## no critic (Modules::RequireEndWithOne)
 		}
 	} elsif ($env->{PATH_INFO} eq "$prefix/metagen") {
 		if (defined($env->{HTTP_REPO})) {
-			($status, $content, $msg) = metagen ($env->{HTTP_REPO});
+			($status, $content, $msg) = Metagen ($env->{HTTP_REPO});
 		}
 	} elsif ($env->{PATH_INFO} eq "$prefix/buildinfo") {
 		if (defined($env->{HTTP_REPO})) {
-			($status, $content, $msg) = buildinfo ($env->{HTTP_REPO});
+			($status, $content, $msg) = BuildInfo ($env->{HTTP_REPO});
 		}
 	}