💾 Archived View for gmn.clttr.info › sources › orrg.git › tree › lib › orrg.pm.txt captured on 2024-05-10 at 11:10:17.

View Raw

More Information

⬅️ Previous capture (2023-01-29)

-=-=-=-=-=-=-

#!/usr/bin/perl
# Copyright René Wagner 2020
# licenced under BSD 3-Clause licence
# https://src.clttr.info/rwa/orrg

package orrg;
use strict;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(popular_get popular_add recent_get recent_add write_response %RC); # automatically exported subs

# enable UTF-8 mode for everything	
use utf8;
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';

my $recentfile = 'data/recent.txt';
my $popularfile = 'data/popular.txt';

# define return codes
our %RC = (
	'INPUT', 10,
	'SENSITIVE_INPUT', 11,
	'SUCCESS', 20,
	'TEMPORARY_REDIRECT', 30,
	'PERMANENT_REDIRECT', 31,
	'TEMPORARY_FAILURE', 40,
	'SERVER_UNAVAILABLE', 41,
	'CGI_ERROR', 42,
	'PROXY_ERROR', 43,
	'SLOW_DOWN', 44,
	'PERMANENT_FAILURE', 50,
	'NOT_FOUND', 51,
	'GONE', 52,
	'PROXY_REQUEST_REFUSE', 53,
	'BAD_REQUEST', 59,
	'CLIENT_CERT_REQUIRED', 60,
	'CERT_NOT_AUTHORISED', 61,
	'CERT_NOT_VALID', 62
);

sub recent_get
{
	(-f $recentfile) or return undef;

	my @recents = ();
	open INFILE, '< :encoding(UTF-8)', $recentfile;
	flock INFILE, 1;
	while (<INFILE>) {
   		chomp($_);
		push @recents, $_;	
	}
	flock INFILE, 8;
	close INFILE;
	
	return \@recents;
}

sub recent_add
{
	my ( $uri, $name ) = @_;
	my $recent = recent_get();

	my $newline = "$uri $name";
	open OUTFILE, '> :encoding(UTF-8)', $recentfile;
	flock OUTFILE, 1;
	print OUTFILE "$newline\n";

	my $c = 1;
	foreach (@$recent) {
		if ($newline ne $_) { 
			print OUTFILE "$_\n"; 
			$c++; 
		}
		($c < 10) or last;
	}
	flock OUTFILE, 8;
	close OUTFILE;
}

sub popular_get
{
	(-f $popularfile) or return undef;

	my @populars = ();
	open INFILE, '< :encoding(UTF-8)', $popularfile;
	flock INFILE, 1;
	while (<INFILE>) {
   		chomp($_);
		push @populars, $_;	
	}
	flock INFILE, 8;
	close INFILE;
	
	return \@populars;
}

sub popular_add
{
	my ( $uri, $name ) = @_;
	my $populars = popular_get();

	open OUTFILE, '> :encoding(UTF-8)', $popularfile;
	flock OUTFILE, 1;

	my $found = 0;
	foreach (@$populars) {
		my ($cnt, $popuri, $popname) = split / /, $_, 3;
		if ($uri eq $popuri) {
			$cnt++;
			$found = 1;
		}
		print OUTFILE "$cnt $popuri $popname\n"; 
	}
	$found or print OUTFILE "1 $uri $name";
	flock OUTFILE, 8;
	close OUTFILE;
}

sub write_response
{
	my ($returncode, $meta, @content) = @_;
	
	defined($RC{$returncode}) or die "Unknown response code!";

	printf("%d %s\r\n", $RC{$returncode}, ($meta eq '') ? $returncode : $meta);
	foreach (@content) {
		print("$_\r\n");
	}

	exit;
}

1;