<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/env perl

# Simple test script to generate a table of latest build links
# Need to determine what to do with iso and source links
# Resisted the temptation to use Moose or any non standard perl modules
# abs@netbsd.org - put into the public domain

use warnings;
use strict;

my @arch_exclude_dirs = qw(source iso);
my $basepath          = '/ftp/pub/NetBSD-daily';
my $baseurl           = '/pub/NetBSD-daily';

package LatestBuilds;

use fields qw(_archlist _basepath _baseurl _taglist _build_counts
	_latest_build_by_archtag);

sub new {
    my LatestBuilds $self = shift;
    $self = fields::new($self) unless ref $self;
    my %param = @_;
    foreach my $param ( keys %param ) {
        $self-&gt;{ '_' . $param } = $param{$param};
    }

    my %latest_build_by_archtag;
    my %tags;
    foreach my $path ( _listsubdirdepth( 3, $basepath ) ) {
        my ( $arch, $build, $tag ) = reverse split( '/', $path );
        next if grep( $arch eq $_, @arch_exclude_dirs );

        # We rely on _listsubdirdepth() returning a sorted list of paths
        $build =~ /(\d{8})/;
        my $date = $1 || $build;
        my $path = "$tag/$build/$arch";
        $latest_build_by_archtag{$arch}{$tag} = {
            date =&gt; $date,
            name =&gt; $build,
            path =&gt; $path,
            url  =&gt; $self-&gt;{_baseurl} . "/" . $path
        };
        ++$tags{$tag};
    }

    my %build_counts;
    foreach my $taghash (values %latest_build_by_archtag)
	{
	foreach my $build (values(%{$taghash}))
	    {
	    ++$build_counts{$build-&gt;{name}};
	    }
	}

    $self-&gt;{_archlist}                = [ sort keys %latest_build_by_archtag ];
    $self-&gt;{_taglist}                 = [ sort keys %tags ];
    $self-&gt;{_latest_build_by_archtag} = \%latest_build_by_archtag;
    $self-&gt;{_build_counts} 	      = \%build_counts;

    return $self;
}

sub taglist  { @{ $_[0]-&gt;{_taglist} } }
sub basepath { $_[0]-&gt;{_basepath} }
sub archlist { @{ $_[0]-&gt;{_archlist} } }
sub build_counts { $_[0]-&gt;{_build_counts} }

sub by_arch_tag {
    my ( $self, $arch, $tag ) = @_;
    my $build = $self-&gt;{_latest_build_by_archtag}{$arch}{$tag};
    return $build;
}

# Returns an alpha sorted list of directories
sub _listsubdirdepth {
    my ( $depth, @dirs ) = @_;
    my @subdirs;
    foreach my $dir ( sort @dirs ) {
        opendir( DIR, $dir ) || die("Unable to opendir($dir): $!");
        push( @subdirs,
            sort grep( !/^\./ &amp;&amp; ( $_ = "$dir/$_" ) &amp;&amp; -d $_, readdir(DIR) ) );
        closedir(DIR);
    }
    return _listsubdirdepth( $depth - 1, @subdirs ) if $depth &gt; 1;
    return @subdirs;
}


package main;

use Getopt::Std;

my %opt;
if (!getopts('ho:v', \%opt) || $opt{h}) {
    print "Usage: $0 [opts]
opts:	-h	This help
	-o file Write output to file
	-v	Verbose
";
    exit;
}

my $latest_builds =
  new LatestBuilds( basepath =&gt; $basepath, baseurl =&gt; $baseurl );

if($opt{v}) {
    print 'tags: ' . scalar($latest_builds-&gt;taglist()) . "\n";
    print 'archs: ' . scalar($latest_builds-&gt;archlist()) . "\n";
    my %build_counts = %{$latest_builds-&gt;build_counts()};
    foreach my $build (sort keys %build_counts) {
	print "build $build: ". scalar($build_counts{$build}). "\n";
    }
}

my $headings = "&lt;tr&gt;\n\t&lt;th&gt;&lt;/th&gt;\n";
foreach my $tag ( $latest_builds-&gt;taglist() ) {
    $headings .= "\t&lt;th&gt;$tag&lt;/th&gt;\n";
}
$headings .= "&lt;/tr&gt;\n";

my $output = "&lt;table&gt;\n$headings";

foreach my $arch ( $latest_builds-&gt;archlist() ) {
    $output .= "&lt;tr&gt;\n\t&lt;th&gt;$arch&lt;/th&gt;\n";
    foreach my $tag ( $latest_builds-&gt;taglist() ) {
        my $build = $latest_builds-&gt;by_arch_tag( $arch, $tag );
        if ($build) {
            $output .= qq{\t&lt;td&gt;&lt;a href="$build-&gt;{url}"&gt;$build-&gt;{date}&lt;/a&gt;&lt;/td&gt;\n};
        }
        else {
            $output .= "\t&lt;td&gt;&amp;nbsp;&lt;/td&gt;\n";
        }
    }
    $output .= "&lt;/tr&gt;\n";
}
$output .= "$headings&lt;/table&gt;\n";

if ($opt{o}) {
    my $tmpfile = "$opt{o}.$$.tmp";
    open(FILE, "&gt;$tmpfile") || die("Unable to write $tmpfile: $!");
    print FILE $output;
    close(FILE);
    unless (rename($tmpfile, $opt{o}) ) {
	unlink($tmpfile);
	die "Unable to rename $tmpfile over $opt{o}";
    }
}
else {
    print $output;
}
exit;
</pre></body></html>