#!/usr/bin/perl
# Last updated: <2024/06/08 22:48:29 +0900>
#
# Update hns cat.txt
#
# Usage: perl update_hnf_cat.pl [--clean]
#
# * Windows10 x64 22H2 + Strawberry Perl 5.32.1.1-x64
# * Debian Linux 10 buster + Perl 5.28.1 i686
#
# Author  : mieki256
# Version : 1.0
# License : CC0 / Public Domain

use strict;
use warnings;
use POSIX 'strftime';
use File::Copy;
use File::Spec;
use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat);

my ( $hnfdir, $cattxtdpath, $lock_dir );
my ( $lastcheck, $nowtime );

if ( $^O eq "MSWin32" ) {

    # Windows
    $hnfdir      = "D:/home/diary/diary";
    $cattxtdpath = "D:/home/diary/public_html/diary/cat";
    $lock_dir    = "D:/home/diary/diary/log/update_hnf_cat_lock";
}
else {
    # Linux
    $hnfdir      = "/home/mieki256/diary";
    $cattxtdpath = "/home/mieki256/public_html/diary/cat";
    $lock_dir    = "/home/mieki256/diary/log/update_hnf_cat_lock";
}

# get option
my ( $clean, $help );
GetOptions( "clean|c" => \$clean, "help|h" => \$help ) or die;
if ($help) {
    print "Usage: perl $0 [--clean] [--help]\n";
    exit(0);
}

# create lock directory
my $retry = 3;
while ( !mkdir( $lock_dir, 0755 ) ) {
    $retry--;
    if ( $retry <= 0 ) {
        print "BUSY : $0\n";
        exit(0);
    }
    sleep(1);
}

&main();

# delete lock directory
rmdir($lock_dir);

exit(0);

sub main {
    my $lastchkfile = File::Spec->catfile( $cattxtdpath, ".last_check" );
    unless ($clean) {
        $lastcheck = &get_last_check($lastchkfile);
    }
    else {
        $lastcheck = 0;
    }
    $nowtime = time();
    print "Last check: ", &unixtime2localtime($lastcheck), "\n";
    print "Now time  : ", &unixtime2localtime($nowtime),   "\n";

    my %cathash = ();

    unless ($clean) {
        %cathash = &read_cat_txt($cattxtdpath);
    }

    # get hnf file list
    my @hnfdirs  = &get_hnf_dirs($hnfdir);
    my @hnffiles = &get_hnf_files(@hnfdirs);

    # scan hnf. get CAT name
    my @addcats = ();
    foreach my $fpath (@hnffiles) {
        my %cats = &scan_hnf($fpath);
        while ( my ( $k, $v ) = each(%cats) ) {
            if ( exists( $cathash{$k} ) ) {
                $cathash{$k} += $v;
            }
            else {
                $cathash{$k} = $v;
                push( @addcats, $k );
            }
        }
    }

    if ( $#addcats >= 0 ) {
        print "\nFound new CAT\n";
        foreach ( sort @addcats ) {
            print "[$_]\n";
        }
        &update_cat_txt( $cattxtdpath, sort keys(%cathash) );
    }

    &update_last_check($lastchkfile);
}

sub get_last_check {
    my ($lastchkfile) = @_;
    my $last = 0;
    if ( -e $lastchkfile ) {
        open( my $fh, "<", $lastchkfile )
            or die "Could not open file: $!";
        $last = <$fh>;
        chomp($last);
        close($fh);
    }
    return $last;
}

sub update_last_check {
    my ($lastchkfile) = @_;
    open( my $fh, ">", $lastchkfile ) or die "Could not open file: $!";
    print $fh "$nowtime\n";
    close($fh);
}

sub read_cat_txt {
    my ($cattxtdpath) = @_;
    my %cathash       = ();
    my $cattxtpath    = File::Spec->catfile( $cattxtdpath, "cat.txt" );

    open( my $fh, "<", $cattxtpath ) or die "Could not open file: $!";
    while (<$fh>) {
        chomp;
        if ( exists( $cathash{$_} ) ) {
            $cathash{$_}++;
        }
        else {
            $cathash{$_} = 1;
        }
    }
    close($fh);
    return %cathash;
}

sub update_cat_txt {
    my ( $cattxtdpath, @newcats ) = @_;
    my $now      = strftime "%Y%m%d_%H%M%S", localtime;
    my $bakfile  = "cat.txt.$now.bak";
    my $oldfpath = File::Spec->catfile( $cattxtdpath, "cat.txt" );
    my $newfpath = File::Spec->catfile( $cattxtdpath, $bakfile );

    print "Backup cat.txt -> $bakfile\n";
    copy( $oldfpath, $newfpath ) or die "Could not backup file: $!";

    print "Update cat.txt\n";
    open( my $fh, ">", $oldfpath ) or die "Could not open file: $!";
    binmode $fh;
    foreach (@newcats) {
        print $fh "$_\n";
    }
    close($fh);
    print "Sucess.\n";
}

sub unixtime2localtime {
    my ($unixtm) = @_;
    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst )
        = localtime($unixtm);
    my @week_list = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );
    my $week      = $week_list[$wday];
    my $date      = sprintf(
        "%04d/%02d/%02d (%s) %02d:%02d:%02d",
        $year + 1900,
        $mon + 1, $mday, $week, $hour, $min, $sec
    );
    return $date;
}

sub dump_cat_txt {
    my (%cathash) = @_;
    my $s = "";
    foreach ( sort keys(%cathash) ) {
        print $_ . ", ";
    }
    print "\n\n";
}

sub get_hnf_dirs {
    my ($hnfdir) = @_;
    opendir( my $dh, $hnfdir );
    my @dirs = ();
    foreach ( readdir($dh) ) {
        next if /^\.{1,2}$/;
        if (/^\d{4}$/) {
            my $fpath = File::Spec->catfile( $hnfdir, $_ );
            if ( -d $fpath ) {
                push( @dirs, $fpath );
            }
        }
    }
    closedir($dh);
    return @dirs;
}

sub get_hnf_files {
    my (@dirs) = @_;
    my @hnffiles = ();
    foreach my $dirpath (@dirs) {
        my @files  = glob( $dirpath . "/*.hnf" );
        my $length = @files;

        # print "$dirpath : hnf files = $length\n";

        foreach (@files) {
            my @stat = stat($_);
            if ( $stat[9] >= $lastcheck ) {

                # found new hnf file
                push( @hnffiles, $_ );
            }
        }
    }
    return @hnffiles;
}

sub scan_hnf {
    my ($fpath) = @_;
    print "$fpath\n";

    my %cathash = ();
    open( my $fh, "<", $fpath ) or die "Cound not open file: $!";
    while (<$fh>) {
        chomp;
        if ( $_ =~ /^CAT\s+(.+)$/ ) {
            my @lst = split( /\s+/, $1 );
            foreach my $s (@lst) {
                next if ( $s eq "CAT" );
                next if ( $s eq " " );
                next if ( $s eq "" );
                if ( exists( $cathash{$s} ) ) {
                    $cathash{$s}++;
                }
                else {
                    $cathash{$s} = 1;
                }
            }
        }
    }
    close($fh);
    return %cathash;
}