#!/usr/bin/perl
use strict;
use warnings;

use File::Basename;
use CGI qw(:standard);

# The directory where the .update files describing update versions are kept
my $update_def_dir = dirname($0)."/update/update-definitions";
# The directory where version descriptions (mini release notes) are kept
my $update_desc_dir = dirname($0)."/update/update-descriptions";


sub main {
  my $query = new CGI;

  my %client_info = $query->Vars;
  my @updates = load_all_updates();

  # Make sure we have all the necessary arguments
  unless (defined($client_info{os}) &&
          defined($client_info{arch}))
  {
    print_appcast(undef);
    return;
  }
  $client_info{intl} = 0 if !defined($client_info{intl});
  $client_info{lang} = "en" if !defined($client_info{lang});

  my $best_update = latest_supported_update(\%client_info, \@updates);
  print_appcast($best_update);
}

sub print_appcast_header {
  print header(-type => "text/xml", -charset => "utf-8");

  print <<EOF;
<?xml version="1.0" encoding="UTF-8"?>
<rss xmlns:sparkle="http://www.andymatuschak.org/xml-namespaces/sparkle" version="2.0">
  <channel>
    <title>Camino Updates</title>
    <link>http://caminobrowser.org</link>
    <description>Camino Updates</description>
    <language>en</language>
EOF
}

sub print_appcast_footer {
  print <<EOF;
  </channel>
</rss>
EOF
}

# Prints an appcast containing the given update, or an empty appcast if no
# update is given.
sub print_appcast {
  my ($update) = @_;

  print_appcast_header();
  if ($update) {
    $update->{FileURL} =~ s/&/&amp;/g;

    print <<EOF;
    <item>
      <title>Camino $update->{VersionString}</title>
      <pubDate>$update->{Date}</pubDate>
      <author>The Camino Project</author>
      <description><![CDATA[
        $update->{Description}
      ]]></description>
      <link>http://caminobrowser.org</link>
      <enclosure url="$update->{FileURL}" length="$update->{FileSize}" sparkle:version="$update->{Version}" sparkle:shortVersionString="$update->{VersionString}" sparkle:dsaSignature="$update->{FileSignature}" type="application/octet-stream"/>
    </item>
EOF
  }
  print_appcast_footer();
}

# Reads the given file describing an update version, and returns the information
# about it as a hash.
sub load_update_definition {
  my ($filepath) = @_;
  my %update;
  open INFILE, '<', $filepath or return;
  while (my $line = <INFILE>) {
    #skip comments
    next if $line =~ /^#/;

    if ($line =~ /(.*?[^ ])\s*=\s*(.*)$/) {
      if (($1 eq "Arch") or ($1 eq "Intl")) {
        my @values = split(/\s*,\s*/, $2);
        $update{$1} = \@values;
      } else {
        $update{$1} = $2;
      }
    }
  }
  close INFILE;
  return \%update;
}

# Returns an array containing the information about all available versions.
sub load_all_updates {
  my @updates;
  for my $file (glob("$update_def_dir/*.update")) {
    push @updates, load_update_definition($file);
  }
  return @updates;
}

# Returns the highest-version update from @$updates that meets the requirements
# of %$client_info, or undef if there is no such version.
sub latest_supported_update {
  my ($client_info, $updates) = @_;
  my $include_pre_release = client_wants_pre_release_builds($client_info);
  # Sort the updates from newest to oldest.
  my @sorted_updates = sort { compare_versions($b->{Version}, $a->{Version}) } @$updates;
  # Then return the first one that meets the requirements.
  for my $update (@sorted_updates) {
    if (client_meets_platform_requirements($client_info, $update) &&
        client_internationalization_matches_update($client_info, $update) &&
        client_meets_camino_version_requirement($client_info, $update) &&
        ($include_pre_release || version_is_release($update->{VersionString})))
    {
      # Load the description in the approriate language.
      $update->{Description} = localized_description($update->{VersionString},
                                                     $client_info->{lang});
      return $update;
    }
  }
  return;
}

# Returns true if the given version is a release version (i.e., not an alpha,
# beta, nightly, or release candidate).
# We have release candidate as a non-release so that we can update testers to
# RC builds before doing a full release.
sub version_is_release {
  my ($version) = @_;
  # The localized build marker is Int, but check for Intl as well just in
  # case someone gets mixed up (since we use Intl in our update descriptions).
  $version =~ s/\s*intl?$//i;
  return $version !~ /(?:(?:a|b)\d*|pre|rc)$/;
}

# Returns true if the client is capable of running the given update.
sub client_meets_platform_requirements {
  my ($client, $update) = @_;
  return (compare_versions($client->{os}, $update->{MinOSVersion}) >= 0) &&
          array_contains($update->{Arch}, $client->{arch});
}

# Returns true if the client meets the minimum Camino version requirement
# for the given update (if any). This allows us to control whether or not
# alpha/beta/nightly users jump across branches, for example.
sub client_meets_camino_version_requirement {
  my ($client, $update) = @_;
  return 1 unless defined($update->{MinCaminoVersionString});
  return compare_versions($client->{version},
                          $update->{MinCaminoVersionString}) >= 0;
}

# Returns true if the update provides the same internationalization option that
# the client currently has. It's possible for an update to provide both options
# in case we merge en-only and intl in the future.
sub client_internationalization_matches_update {
  my ($client, $update) = @_;
  return array_contains($update->{Intl}, $client->{intl});
}

# Returns true if the client wants builds other than final releases.
# For now we only offer them to users already using non-release builds, but
# we probably want to use a real track-based system eventually.
sub client_wants_pre_release_builds {
  my ($client) = @_;
  return !version_is_release($client->{version});
}

# Performs a <=> style comparison on two OS or Camino versions
sub compare_versions {
  my ($a, $b) = @_;
  # Split the version into its component parts.
  my ($a_num, $a_stage, $a_is_nightly) = version_components($a);
  my ($b_num, $b_stage, $b_is_nightly) = version_components($b);
  # Sanity checks
  return 0 if (!defined($a_num) && !defined($b_num));
  return -1 if !defined($a_num);
  return 1 if !defined($b_num);

  # Start by comparing the numeric part of the version.
  my $comparison = compare_numeric_versions($a_num, $b_num);
  return $comparison if $comparison != 0;
  # If all those match, is one an earlier stage?
  $comparison = compare_stages($a_stage, $b_stage);
  return $comparison if $comparison != 0;
  # Still the same, eh? Then it all hinges on whether one is a nightly.
  $comparison = !$a_is_nightly <=> !$b_is_nightly;
  return $comparison;
}

# Given a Camino version string, returns an array containing:
# (numeric version, stage (e.g, 'a', 'b1', 'rc'), is-nightly-or-not).
sub version_components {
  my ($version) = @_;
  my ($num, $stage, $pre) = ($version =~ /^([\d.]+)([ab]\d*|rc)?(pre)?/);
  return ($num, $stage, defined($pre));
}

# Performs a <=> style comparison on two numeric versions (X, X.Y, X.Y.Z, etc.).
sub compare_numeric_versions {
  my ($a, $b) = @_;
  my @a_parts = version_number_components($a);
  my @b_parts = version_number_components($b);
  # As soon as we get a bigger or smaller number, we're done.
  for (my $i = 0; $i < scalar(@a_parts) && $i < scalar (@b_parts); $i++) {
    my $comparison = $a_parts[$i] <=> $b_parts[$i];
    return $comparison if $comparison != 0;
  }
  # If they start the same but one has more numbers, the one with the extra
  # number is later (e.g., 10.5.1 > 10.5)
  return $#a_parts <=> $#b_parts;
}

# Returns the individual components of a X, X.Y, X.Y.Z, etc. version as an
# array, removing any final .0s to get a canonical form (10.4.0 -> (10, 4)).
sub version_number_components {
  my ($version) = @_;
  $version =~ s/(\.0+)+$//;
  return split(/\./, $version);
}

# Performs a <=> style comparison on two Camino "stages": the alpha/beta/rc
# suffix on the version (e.g., "a1", "b", "rc").
sub compare_stages {
  my ($a, $b) = @_;
  # If a or b is undefined, it's an actual release; convert that to 'z' so
  # we can just use a straight string comparison to get the correct ordering.
  # ('aX' < 'bX' < 'rc' < 'z') -> (alpha < beta < release candidate < release).
  # This also handles 'b1' < 'b2', since lower digits compare lower as strings.
  # If we are ever crazy enough to release a 'b10', we'll need to add logic.
  $a = 'z' unless defined($a);
  $b = 'z' unless defined($b);
  return $a cmp $b;
}

# Returns 1 if @$array contains $object, 0 otherwise.
sub array_contains {
  my ($array, $object) = @_;
  for my $array_entry (@$array) {
    return 1 if $object eq $array_entry;
  }
  return 0;
}

# Get the description for the $version, in $language. If $language is
# not available but a non-locale specific version is that will be used;
# if no matching language is available, it will use English.
sub localized_description {
  my ($version, $language) = @_;
  $version =~ s/\s*Int.*$//;
  my $description_file = "$update_desc_dir/$version-$language";
  # If we don't have a match, try a non-locale match
  if (!-e $description_file) {
    $language =~ s/[-_]\w+$//;
    $description_file = "$update_desc_dir/$version-$language";
  }
  # Fall back to English if we don't have anything close
  if (!-e $description_file) {
    $description_file = "$update_desc_dir/$version-en";
  }
  # If we really have nothing, then we're out of luck
  return "" unless -e $description_file;

  local $/;
  open INFILE, '<', $description_file or return "";
  my $description = <INFILE>;
  close INFILE;
  return $description;
}

main();
