#! /usr/bin/perl
#
# addpost.pl
#
# This script will add dropped feedlog data from a single posting.
#
# It is part of the NewsStats package.
#
# Copyright (c) 2025 Thomas Hochstein <thh@thh.name>
#
# It can be redistributed and/or modified under the same terms under
# which Perl itself is published.

BEGIN {
  use File::Basename;
  # we're in .../bin, so our module is in ../lib
  push(@INC, dirname($0).'/../lib');
}
use strict;
use warnings;

use NewsStats qw(:DEFAULT ParseHeaders);
require '/usr/lib/news/innshellvars.pl';

use Date::Format;
use DBI;
use Encode qw(encode);
use Getopt::Long qw(GetOptions);
Getopt::Long::config ('bundling');

################################# Subroutines ##################################

# taken from cancelwatch.pl by Ralf Doeblitz
sub safe_pipe_fork($) {
  my ($pid, $sleep_count);
  my $name=shift;

  do {
    $pid = open(KID, $name);
    unless (defined $pid) {
      warn "cannot fork: $!";
      die "bailing out" if $sleep_count++ > 6;
      sleep 10;
    }
  } until defined $pid;

  return ($pid);
}

# taken from cancelwatch.pl by Ralf Doeblitz
sub safe_pipe_read(@) {
  my @cmd = @_;
  my $pid = safe_pipe_fork('-|');

  if ($pid) { # parent
    my @a=<KID>; 
    close KID or die "child exited: $?";
    return @a;
  } else {
    exec { $cmd[0] } @cmd;
    exit -1;
  }
}
################################# Main program #################################

### read commandline options
my ($OptRawDB,$OptConfFile);
GetOptions ('rawdb=s'         => \$OptRawDB,
            'conffile=s'      => \$OptConfFile,
            'h|help'          => \&ShowPOD,
            'V|version'       => \&ShowVersion) or exit 1;

### read configuration
my %Conf = %{ReadConfig($OptConfFile)};

### override configuration via commandline options
my %ConfOverride;
$ConfOverride{'DBTableRaw'}   = $OptRawDB if $OptRawDB;
&OverrideConfig(\%Conf,\%ConfOverride);

### init database
my $DBHandle   = InitDB(\%Conf,1);
my $DBRaw      = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableRaw'});

### parsing data ---------------------------------------------------------------
# feedlog will get $Mid, $Timestamp, $Token, $Size, $Peer, $Path, $Newsgroups and $Headers

# get MID from @ARGV
my $Mid = $ARGV[0];
&Bleat(2, "No Message-ID given!\nUsage: addpost.pl <Message-ID>") if !$Mid;

# get storage token from MID
my ($Token) = safe_pipe_read("$inn::newsbin/grephistory", $Mid);
chomp($Token);

# get arrival time from history
my $Timestamp;
open(my $HISTORY, '<', $inn::history)
    or die "Can't open $inn::history: $!";
while (<$HISTORY>)
{
  next unless /$Token/;
  $_ =~ /^\[.+\]\s+(\d+)~/;
  $Timestamp = $1;
}

# get headers, $Path and $Newsgroups
my @Headers = safe_pipe_read("$inn::newsbin/sm", '-H', $Token);
my $Headers = join("", @Headers);
my %Header = ParseHeaders(split(/\n/,$Headers));
my $Path = $Header{'path'};
my $Newsgroups = $Header{'newsgroups'};
# get $Peer
$Path =~ /^news.szaf.org!([^!]+)/;
my $Peer = $1;
# get size
my @Article = safe_pipe_read("$inn::newsbin/sm", $Token);
my $Article = join("", @Article);
my $Size = length($Article);

# convert headers to UTF-8, if necessary
$Headers = encode('utf-8', $Headers) if ($Headers =~ /[\x80-\x{ffff}]/);

# parse timestamp to day (YYYY-MM-DD) and to MySQL timestamp
my $Day  = time2str("%Y-%m-%d", $Timestamp);
my $Date = time2str("%Y-%m-%d %H:%M:%S", $Timestamp);

### write to database
my $DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s.%s (day,date,mid,
                                         timestamp,token,size,peer,path,
                                         newsgroups,headers)
                                         VALUES (?,?,?,?,?,?,?,?,?,?)",
                                         $Conf{'DBDatabase'},
                                         $Conf{'DBTableRaw'}));

if (!$DBQuery->execute($Day, $Date, $Mid, $Timestamp, $Token, $Size, $Peer,
                       $Path, $Newsgroups, $Headers)) {
  &Bleat(2, sprintf('Database error %s while processing %s: %s',
         $DBI::err, $Mid, $DBI::errstr));
};
$DBQuery->finish;

### close handles
close $HISTORY;
$DBHandle->disconnect;

__END__

################################ Documentation #################################

=head1 NAME

addpost - add data for a single posting to a database

=head1 SYNOPSIS

B<addlog> [B<-Vh>] [B<--conffile> I<filename>] [B<--rawdb> I<database table>] I<Message-ID>

=head1 REQUIREMENTS

See L<doc/README>.

=head1 DESCRIPTION

This script will log overview data and complete headers to a database
table for further examination for a single posting, identified by its
Message-ID. It's intended to add postings dropped by F<feedlog>.

=head2 Configuration

B<feedlog> will read its configuration from F<newsstats.conf> which
should be present in etc/ via Config::Auto or from a configuration file
submitted by the B<--conffile> option.

See L<doc/INSTALL> for an overview of possible configuration options.

You can override the database written to by using the B<--rawdb>
option.

=head1 OPTIONS

=over 3

=item B<-V>, B<--version>

Display version and copyright information and exit.

=item B<-h>, B<--help>

Display this man page and exit.

=item B<--conffile> I<filename>

Read configuration from I<filename> instead of F<newsstats.conf>.

=item B<--rawdb> I<table> (raw data table)

Override I<DBTableRaw> from F<newsstats.conf>.

=back

=head1 INSTALLATION

See L<doc/INSTALL>.

=head1 EXAMPLES

Add a posting with Message-ID: <mylocalpart@domain.example>

    addposts -- '<mylocalpart@domain.example>'

=head1 FILES

=over 4

=item F<bin/addlog.pl>

The script itself.

=item F<lib/NewsStats.pm>

Library functions for the NewsStats package.

=item F<etc/newsstats.conf>

Runtime configuration file.

=back

=head1 BUGS

Please report any bugs or feature requests to the author or use the
bug tracker at L<https://code.virtcomm.de/thh/newsstats/issues>!

=back

This script is part of the B<NewsStats> package.

=head1 AUTHOR

Thomas Hochstein <thh@thh.name>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2025 Thomas Hochstein <thh@thh.name>

This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.

=cut