From http://www.jwz.org/xscreensaver/xscreensaver-5.24.tar.gz

[xscreensaver] / OSX / updates.pl

#!/usr/bin/perl -w
# Copyright © 2013 Jamie Zawinski <jwz@jwz.org>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Generates updates.xml from README, archive/, and www/.
#
# Created: 27-Nov-2013.

require 5;
use diagnostics;
use strict;

use open ":encoding(utf8)";
use POSIX;

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.1 $ }; $version =~ s/^[^\d]+([\d.]+).*/$1/;

my $verbose = 0;
my $debug_p = 0;

my $base_url = "http://www.jwz.org/";
my $priv_key_file = "$ENV{HOME}/.ssh/sparkle_dsa_priv.pem";
my $sign_update = "./sign_update.rb";


sub generate_xml($$$$) {
  my ($app_name, $changelog, $archive_dir, $www_dir) = @_;

  my $outfile = "updates.xml";

  my $obody = '';
  my %sigs;
  my %dates;
  if (open (my $in, '<', $outfile)) {
    print STDERR "$progname: reading $outfile\n" if $verbose;
    local $/ = undef;  # read entire file
    $obody = <$in>;
    close $in;
    foreach my $item (split (/<item/i, $obody)) {
      my ($v)    = ($item =~ m/version="(.*?)"/si);
      my ($sig)  = ($item =~ m/dsaSignature="(.*?)"/si);
      my ($date) = ($item =~ m/<pubDate>(.*?)</si);
      next unless $v;
      $sigs{$v}  = $sig  if $sig;
      $dates{$v} = $date if $date;
    }
  }

  open (my $in, '<', $changelog) || error ("$changelog: $!");
  print STDERR "$progname: reading $changelog\n" if $verbose;
  local $/ = undef;  # read entire file
  my $body = <$in>;
  close $in;

  my $rss = "";

  $body =~ s/^(\d+\.\d+[ \t])/\001$1/gm;
  my @log = split (/\001/, $body);
  shift @log;
  foreach my $log (@log) {
    my ($v1, $entry) = ($log =~ m/^(\d+\.\d+)\s+(.*)$/s);

    $entry =~ s/^\s*\d\d?[- ][A-Z][a-z][a-z][- ]\d{4}:?\s+//s;  # lose date

    $entry =~ s/^\s+|\s+$//gs;
    $entry =~ s/^\s+|\s+$//gm;
    $entry =~ s/^[-*] /<BR>&bull; /gm;
    $entry =~ s/^<BR>//si;
    $entry =~ s/\s+/ /gs;

    my $v2 = $v1; $v2 =~ s/\.//gs;
    my $zip = undef;
  DONE:
    foreach my $ext ('zip', 'dmg', 'tar.gz', 'tar.Z') {
      foreach my $v ($v1, $v2) {
        foreach my $name ($app_name, "x" . lc($app_name)) {
          my $f = "$name-$v.$ext";
          if (-f "$archive_dir/$f") {
            $zip = $f;
            last DONE;
          }
        }
      }
    }

    my $url = ("${base_url}$app_name/" .
               ($zip && -f "$www_dir/$zip" ? $zip : ""));

    $url =~ s@DaliClock/@xdaliclock/@gs if $url; # Kludge

    my @st = stat("$archive_dir/$zip") if $zip;
    my $size = $st[7];
    my $date = $st[9];
    $date = ($zip ?
             strftime ("%a, %d %b %Y %T %z", localtime($date))
             : "");

    my $odate = $dates{$v1};
    my $sig   = $sigs{$v1};
    # Re-generate the sig if the file date changed.
    $sig = undef if ($odate && $odate ne $date);

    if (!$sig && $zip) {
      local %ENV = %ENV;
      $ENV{PATH} = "/usr/bin:$ENV{PATH}";
      $sig = `$sign_update "$archive_dir/$zip" "$priv_key_file"`;
      $sig =~ s/\s+//gs;
    }

    my $enc = ($zip && -f "$www_dir/$zip"
               ? ("<enclosure url=\"$url\"\n" .
                  " sparkle:version=\"$v1\"\n" .
                  " sparkle:dsaSignature=\"$sig\"\n" .
                  " length=\"$size\"\n" .
                  " type=\"application/octet-stream\" />\n")
               : "<sparkle:version>$v1</sparkle:version>\n");

    $enc =~ s/^/ /gm if $enc;
    my $item = ("<item>\n" .
                " <title>Version $v1</title>\n" .
                " <link>$url</link>\n" .
                " <description><![CDATA[$entry]]></description>\n" .
                " <pubDate>$date</pubDate>\n" .
                $enc .
                "</item>\n");
    $item =~ s/^/  /gm;

    # I guess Sparkle doesn't like info-only items.
    $item = '' unless ($zip && -f "$www_dir/$zip");

    $rss .= $item;
  }

  $rss = ("<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" .
          "<rss version=\"2.0\"\n" .
          "     xmlns:sparkle=\"http://www.andymatuschak.org/" .
               "xml-namespaces/sparkle\"\n" .
          "     xmlns:dc=\"http://purl.org/dc/elements/1.1/\">\n" .
          " <channel>\n" .
          "  <title>$app_name updater</title>\n" .
          "  <link>${base_url}$app_name/updates.xml</link>\n" .
          "  <description>Updates to $app_name.</description>\n" .
          "  <language>en</language>\n" .
          $rss .
          " </channel>\n" .
          "</rss>\n");

  if ($rss eq $obody) {
    print STDERR "$progname: $outfile: unchanged\n";
  } else {
    my $tmp = "$outfile.tmp";
    open (my $out, '>', $tmp) || error ("$tmp: $!");
    print $out $rss;
    close $out;
    if ($debug_p) {
      system ("diff", "-wNU2", "$outfile", "$tmp");
      unlink $tmp;
    } else {
      if (!rename ("$tmp", "$outfile")) {
        unlink "$tmp";
        error ("mv $tmp $outfile: $!");
      } else {
        print STDERR "$progname: wrote $outfile\n";
      }
    }
  }
}


sub error($) {
  my ($err) = @_;
  print STDERR "$progname: $err\n";
  exit 1;
}

sub usage() {
  print STDERR "usage: $progname [--verbose] app-name changelog archive www\n";
  exit 1;
}

sub main() {
  my ($app_name, $changelog, $archive_dir, $www_dir);
  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if (m/^--?verbose$/)  { $verbose++; }
    elsif (m/^-v+$/)      { $verbose += length($_)-1; }
    elsif (m/^--?debug$/) { $debug_p++; }
    elsif (m/^-./)        { usage; }
    elsif (!$app_name)    { $app_name = $_; }
    elsif (!$changelog)   { $changelog = $_; }
    elsif (!$archive_dir) { $archive_dir = $_; }
    elsif (!$www_dir)     { $www_dir = $_; }
    else { usage; }
  }

  usage unless $www_dir;
  generate_xml ($app_name, $changelog, $archive_dir, $www_dir);

}

main();
exit 0;