touch_files.pl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

#! /usr/bin/perl

# This script is still used in 2024

# this script finds new files and touches old ones so that the list of
# languages at the bottom is updated to include the new file.
# or something like that. made by Joey.

%config = (
	   'wmldir'  => '/org/www.debian.org/webwml',
	   'datadir' => '/org/www.debian.org/cron/datafiles',
	   );

sub make_listing
{
    unlink ("$config{'datadir'}/wmlfiles.old") if (-f "$config{'datadir'}/wmlfiles.old");
    rename ("$config{'datadir'}/wmlfiles", "$config{'datadir'}/wmlfiles.old") if (-f "$config{'datadir'}/wmlfiles");
    system ("find . -type f -name '*.wml' | sort > $config{'datadir'}/wmlfiles");
}

sub obtain_files
{
    my @list;
    return unless -s "$config{'datadir'}/wmlfiles.old";
    return unless -s "$config{'datadir'}/wmlfiles";
    if (open (IN, "diff $config{'datadir'}/wmlfiles.old $config{'datadir'}/wmlfiles|")) {
	while (<IN>) {
	    next until (/^[<>] \.\//);
	    s/^[<>] \.\///;
	    chomp ();
	    push (@list, $_);
	}
	close (IN);
    }
    return @list;
}

chdir ($config{'wmldir'}) || die;

use Getopt::Std;
$opt_d = 0;
unless (getopts('d')) {
	print <<_END_;
Usage: $0 [-d]

This script finds new translations and translations that have been
removed and touches the translations so they rebuild and include a
link to the new ones and remove links to old ones.

  -d  Remove files, just not report.
_END_
	exit;
}

make_listing ();

@files = obtain_files ();

foreach $file (@files) {
    @components = split (/\//, $file);
    shift @components;
    my $cmd = "touch */" . join '/', @components;
    printf "$cmd\n";
    if ($opt_d) {
      system($cmd) == 0 or die;
    }
}