orrg.pm (2471B)
1 #!/usr/bin/perl 2 # Copyright René Wagner 2020 3 # licenced under BSD 3-Clause licence 4 # https://src.clttr.info/rwa/orrg 5 6 package orrg; 7 use strict; 8 use Exporter; 9 our @ISA = qw(Exporter); 10 our @EXPORT = qw(popular_get popular_add recent_get recent_add write_response %RC); # automatically exported subs 11 12 # enable UTF-8 mode for everything 13 use utf8; 14 binmode STDOUT, ':utf8'; 15 binmode STDERR, ':utf8'; 16 17 my $recentfile = 'data/recent.txt'; 18 my $popularfile = 'data/popular.txt'; 19 20 # define return codes 21 our %RC = ( 22 'INPUT', 10, 23 'SENSITIVE_INPUT', 11, 24 'SUCCESS', 20, 25 'TEMPORARY_REDIRECT', 30, 26 'PERMANENT_REDIRECT', 31, 27 'TEMPORARY_FAILURE', 40, 28 'SERVER_UNAVAILABLE', 41, 29 'CGI_ERROR', 42, 30 'PROXY_ERROR', 43, 31 'SLOW_DOWN', 44, 32 'PERMANENT_FAILURE', 50, 33 'NOT_FOUND', 51, 34 'GONE', 52, 35 'PROXY_REQUEST_REFUSE', 53, 36 'BAD_REQUEST', 59, 37 'CLIENT_CERT_REQUIRED', 60, 38 'CERT_NOT_AUTHORISED', 61, 39 'CERT_NOT_VALID', 62 40 ); 41 42 sub recent_get 43 { 44 (-f $recentfile) or return undef; 45 46 my @recents = (); 47 open INFILE, '< :encoding(UTF-8)', $recentfile; 48 flock INFILE, 1; 49 while (<INFILE>) { 50 chomp($_); 51 push @recents, $_; 52 } 53 flock INFILE, 8; 54 close INFILE; 55 56 return \@recents; 57 } 58 59 sub recent_add 60 { 61 my ( $uri, $name ) = @_; 62 my $recent = recent_get(); 63 64 my $newline = "$uri $name"; 65 open OUTFILE, '> :encoding(UTF-8)', $recentfile; 66 flock OUTFILE, 1; 67 print OUTFILE "$newline\n"; 68 69 my $c = 1; 70 foreach (@$recent) { 71 if ($newline ne $_) { 72 print OUTFILE "$_\n"; 73 $c++; 74 } 75 ($c < 10) or last; 76 } 77 flock OUTFILE, 8; 78 close OUTFILE; 79 } 80 81 sub popular_get 82 { 83 (-f $popularfile) or return undef; 84 85 my @populars = (); 86 open INFILE, '< :encoding(UTF-8)', $popularfile; 87 flock INFILE, 1; 88 while (<INFILE>) { 89 chomp($_); 90 push @populars, $_; 91 } 92 flock INFILE, 8; 93 close INFILE; 94 95 return \@populars; 96 } 97 98 sub popular_add 99 { 100 my ( $uri, $name ) = @_; 101 my $populars = popular_get(); 102 103 open OUTFILE, '> :encoding(UTF-8)', $popularfile; 104 flock OUTFILE, 1; 105 106 my $found = 0; 107 foreach (@$populars) { 108 my ($cnt, $popuri, $popname) = split / /, $_, 3; 109 if ($uri eq $popuri) { 110 $cnt++; 111 $found = 1; 112 } 113 print OUTFILE "$cnt $popuri $popname\n"; 114 } 115 $found or print OUTFILE "1 $uri $name"; 116 flock OUTFILE, 8; 117 close OUTFILE; 118 } 119 120 sub write_response 121 { 122 my ($returncode, $meta, @content) = @_; 123 124 defined($RC{$returncode}) or die "Unknown response code!"; 125 126 printf("%d %s\r\n", $RC{$returncode}, ($meta eq '') ? $returncode : $meta); 127 foreach (@content) { 128 print("$_\r\n"); 129 } 130 131 exit; 132 } 133 134 1;