orrg

commit 373ae43bf2d6f2e6ca2a31beccda552122cd987f
parent 7b18a7528ee0938b19f35bd40ea2a110c80eadc5
Author: René Wagner <rwagner@rw-net.de>
Date:   Sat, 28 Nov 2020 20:08:32 +0100

implement popular list

state is saved in data/popular.txt and must be reset
manually if desired

Diffstat:
M
lib/orrg.pm
 | 
46
+++++++++++++++++++++++++++++++++++++++++++---
M
orrg.pl
 | 
1
+
A
popular.pl
 | 
49
+++++++++++++++++++++++++++++++++++++++++++++++++

3 files changed, 93 insertions(+), 3 deletions(-)
diff --git a/lib/orrg.pm b/lib/orrg.pm
@@ -7,7 +7,7 @@ package orrg;
 use strict;
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT = qw(recent_get recent_add write_response %RC); # automatically exported subs
+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;
@@ -15,6 +15,7 @@ binmode STDOUT, ':utf8';
 binmode STDERR, ':utf8';
 
 my $recentfile = 'data/recent.txt';
+my $popularfile = 'data/popular.txt';
 
 # define return codes
 our %RC = (
@@ -44,12 +45,12 @@ sub recent_get
 
 	my @recents = ();
 	open INFILE, $recentfile;
-	flock OUTFILE, 1;
+	flock INFILE, 1;
 	while (<INFILE>) {
    		chomp($_);
 		push @recents, $_;	
 	}
-	flock OUTFILE, 8;
+	flock INFILE, 8;
 	close INFILE;
 	
 	return \@recents;
@@ -77,6 +78,45 @@ sub recent_add
 	close OUTFILE;
 }
 
+sub popular_get
+{
+	(-f $popularfile) or return undef;
+
+	my @populars = ();
+	open INFILE, $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, '>', $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) = @_;
diff --git a/orrg.pl b/orrg.pl
@@ -47,6 +47,7 @@ sub create_response
 	}
 
 	recent_add($qs, $feed->title);
+	popular_add($qs, $feed->title);
 	push @body, '# '. $feed->title;
 	push @body, 'fetched '. strftime('%Y-%m-%dT%H:%M:%SZ', gmtime());
 	$feed->description eq '' or push @body, ('', $feed->description);
diff --git a/popular.pl b/popular.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+# Copyright René Wagner 2020
+# licenced under BSD 3-Clause licence
+# https://git.sr.ht/~rwa/orrg
+
+use strict;
+no warnings 'experimental';
+use URI::Escape;
+use lib 'lib/';
+use orrg;
+
+# enable UTF-8 mode for everything	
+use utf8;
+binmode STDOUT, ':utf8';
+binmode STDERR, ':utf8';
+
+if (!defined($ENV{'SERVER_PROTOCOL'}) || $ENV{'SERVER_PROTOCOL'} ne 'GEMINI')
+{
+	write_response('CGI_ERROR', '', undef);
+}
+
+write_response('SUCCESS', 'text/gemini', create_response());
+
+exit;
+
+sub create_response
+{
+	my @body = ();
+
+	push @body, ('# most popular feeds', '');
+	
+	my $populars = popular_get();
+	if ( defined($populars) ) {
+		my @sorted = sort { $a <=> $b } @$populars;
+		my $c = 0;
+		foreach (reverse @sorted) {
+			my ($cnt, $uri, $name) = split / /, $_, 3;
+			push @body, '=> orrg.pl?'. uri_escape($uri) .' '. $name;
+
+			++$c < 10 or last;
+		}
+	} else {
+		push @body, 'No feeds found'; 
+	}
+
+
+	push @body, ('', '', '=> index.pl [home]');
+	return @body;
+}