sudat

#!/usr/bin/env perl
# Copyright (c) 2022-2023 Ashlen <eurydice@riseup.net>

# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.

# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# Sync Upload Date and Access Time

use v5.36;
use autodie;
use strict;
use warnings;

# Included modules.
use File::Basename qw(fileparse);
use File::Find;
use Cwd;
use Time::Local qw(timelocal_modern);

# External modules.
use JSON::MaybeXS qw(decode_json);

sub usage {
	my $program_name = fileparse $0;

	die <<"EOT";
Sync Upload Date and Access Time (sudat):
$program_name [file or directory] [...]

Note that $program_name extracts the upload date from .info.json files
provided by yt-dlp(1). .info.json files MUST be identically named to
file_to_update except for the extension.
EOT
}

sub make_file_template {
	my $file_with_extensions = shift
		or die "make_file_template needs a file.\n";

	# This contains all anticipated extensions. A more liberal regular
	# expression runs the risk of oversight (accidentally matching more
	# than was intended--easy to do) and introducing unnecessary
	# complexity.
	my $extension_regexp = '(webm|mkv|mp4|info\.json|description)';

	my $file_without_extensions =
		$file_with_extensions =~ s/\.$extension_regexp\z//gr;

	return $file_without_extensions;
}

sub get_upload_date {
	my $file_to_process = shift or die "get_upload_date needs a file.\n";
	my $file_template = make_file_template $file_to_process;
	my $info_json_file = "$file_template.info.json";

	my $info_json = do {
		local $/;
		open my $info_json_fh, '<', $info_json_file;
		<$info_json_fh>;
	};

	my $decoded_json = decode_json $info_json;
	my $upload_date = $decoded_json->{'upload_date'};
	return $upload_date;
}

sub upload_date_to_epoch {
	my $file_to_process = shift or die "upload_date_to_epoch needs a file.\n";
	my $upload_date = get_upload_date $file_to_process;

	die "Upload date is not eight digits long.\n"
		unless $upload_date =~ /\A \d{8} \z/ax;

	my $year = substr $upload_date, 0, 4;
	my $month = substr $upload_date, 4, 2;
	my $day = substr $upload_date, 6, 2;

	# The month field is the number of months since January, from 0-11.
	return timelocal_modern 0, 0, 0, $day, $month - 1, $year;
}

sub modify_utime {
	my $file_to_process = shift;
	my $file_template = make_file_template $file_to_process;
	my $since_the_epoch = upload_date_to_epoch $file_to_process;

	my @files_to_modify = (
		$file_to_process, "$file_template.info.json",
		"$file_template.description",
	);

	utime $since_the_epoch, $since_the_epoch, @files_to_modify;
}

# Takes an anon function and a list of arguments. Returns a closure
# which will call the anon function with those arguments prepended to
# the argument list.
#
# https://www.perlmonks.org/?node_id=109068
sub make_wanted {
	my ( $sub, @args ) = @_;
	return sub { $sub->( @args, @_ ); };
}

sub wanted {
	return unless /\.(?:mkv|mp4|webm)\z/a;
	return unless -f;

	if ( my $last_update = shift ) {
		return if ( -M _ ) > $last_update;
	}

	modify_utime $_;
}

@ARGV or usage;
my $old_pwd = cwd;

while (<@ARGV>) {
	if (-f) { modify_utime $_; }

	elsif ( -d _ ) {
		chdir $_;

		my $last_update;
		if ( $last_update = -M '.sudat_last_update' ) {
			find( make_wanted( \&wanted, $last_update ), '.' );
		}
		else {
			find( make_wanted( \&wanted ), '.' );
		}

		open my $last_update_fh, '>', '.sudat_last_update';
		close $last_update_fh;
		utime undef, undef, '.sudat_last_update';

		chdir $old_pwd;
	}

	else { warn "'$_' isn't a file or directory, skipping.\n"; }
}