#!/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->{ '_' . $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 => $date, name => $build, path => $path, url => $self->{_baseurl} . "/" . $path }; ++$tags{$tag}; } my %build_counts; foreach my $taghash (values %latest_build_by_archtag) { foreach my $build (values(%{$taghash})) { ++$build_counts{$build->{name}}; } } $self->{_archlist} = [ sort keys %latest_build_by_archtag ]; $self->{_taglist} = [ sort keys %tags ]; $self->{_latest_build_by_archtag} = \%latest_build_by_archtag; $self->{_build_counts} = \%build_counts; return $self; } sub taglist { @{ $_[0]->{_taglist} } } sub basepath { $_[0]->{_basepath} } sub archlist { @{ $_[0]->{_archlist} } } sub build_counts { $_[0]->{_build_counts} } sub by_arch_tag { my ( $self, $arch, $tag ) = @_; my $build = $self->{_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( !/^\./ && ( $_ = "$dir/$_" ) && -d $_, readdir(DIR) ) ); closedir(DIR); } return _listsubdirdepth( $depth - 1, @subdirs ) if $depth > 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 => $basepath, baseurl => $baseurl ); if($opt{v}) { print 'tags: ' . scalar($latest_builds->taglist()) . "\n"; print 'archs: ' . scalar($latest_builds->archlist()) . "\n"; my %build_counts = %{$latest_builds->build_counts()}; foreach my $build (sort keys %build_counts) { print "build $build: ". scalar($build_counts{$build}). "\n"; } } my $headings = "\n\t\n"; foreach my $tag ( $latest_builds->taglist() ) { $headings .= "\t$tag\n"; } $headings .= "\n"; my $output = "\n$headings"; foreach my $arch ( $latest_builds->archlist() ) { $output .= "\n\t\n"; foreach my $tag ( $latest_builds->taglist() ) { my $build = $latest_builds->by_arch_tag( $arch, $tag ); if ($build) { $output .= qq{\t\n}; } else { $output .= "\t\n"; } } $output .= "\n"; } $output .= "$headings
$arch$build->{date} 
\n"; if ($opt{o}) { my $tmpfile = "$opt{o}.$$.tmp"; open(FILE, ">$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;