Somewhat related to things to do whilst waiting for Warlords, I’ve slowly been making gold. I was also curious as to what my gold making looked over time. I’m not a pro-gold maker and I’ve written about some of the things I do before.

That said, I am getting close to the gold cap on a single server.

First the graph

There are some notable events on this graph

The jaggyness of the lin at the start of 2013 is due to the purchase of gold sink mounts – the Grand Expedition Yak, engineering and Jewelcrafting mounts. Each time I reached around 300k gold I’d buy a mount

You can see the move from Earthen Ring to Turalyon – my main shifting in March 2014 and the other chars following a couple of months later.

I did leave one or two characters on Earthen Ring however – mostly to play on the Black Market Auction House – the drop of ~60k in July was me picking up a mount which was listed as-is instead of doing my usual /roll with the Unclaimed Black Market Containers.

The other side of this – where did the data from this come from?

Well, I’ve run Titan Panel for a long time and it includes a gold tracking addon. However it only records spot values. That is, it’s great to see how much gold you have right now, but no good if you want to look back in time.

The back data came from backups made by Time Machine – there is a command line interface to it called tmutil which means you can query its backups and then restore individual files as required.

A little bit of perl to hold it all together and the data for the graph above was generated. I also coded a “day-by-day” mode so new data points will be added to the data file at 5am every day.

The perl code to do this is shown below; note that the code is sufficently wide that you will need to horizontally scroll to see all of it.

#!/usr/local/bin/perl -w

use strict;
use POSIX;
use Getopt::Std;
use File::Temp qw/ :mktemp /;
use Data::Dumper;        
$Data::Dumper::Indent=1;  # Set sane default

# The file we read [-f]
my $DataFile = '/Applications/World of Warcraft/WTF/Account/ACCOUNT/SavedVariables/TitanGold.lua';

# The place we write [-o]
my $Output = "$ENV{HOME}/Desktop/WoWGold.txt";

# The date string we use for new entries [-d]
my $Date = strftime( '%Y-%m-%d', localtime );

# Minimum gold to consider [-g]
my $MinGold = 1000;

# Backfill data? [-B]
my $Backfill = 0;

# Are we debugging ? [-D]
my $Debug = 0;

#-------------------------------------------------------------------------------
# command usage
sub usage {
  my $cmd=(split(/\//,$0))[$#_];
  my $spc=" "x(length($cmd));
  print STDERR < %s\n", $m;
  }
}

#-------------------------------------------------------------------------------
# Parse the LUA data file
# The file has a format like the following:
#
#   GoldSave = {
#          ["CHARNAME_SERVERNAME::FACTION"] = {
#                  ["show"] = true,
#                  ["name"] = "CHARNAME",
#                  ["gold"] = 1026177,
#          },
#   }
#
# Where the amount of gold is actually the number of copper the character has,
# we need to divide by 10,000 to get the amount of gold
#
# We sum up the gold per server and faction. The hash we return has a key
# of the form "Server - faction" with the value being the gold
#
sub parse_file {
  my ($file) = @_;
  my %gold = ();
  die "$0: Failed to open '$file' for reading - $!\n"
    unless open FILE, $file;
  my $server_faction = '';
  while() {
    chomp;
    if ( $server_faction eq '' ) {
      next unless /\["[^_]+_(.*?)::([^"]+)"\] = {/;
      $server_faction = "$1-$2";
      next;
    }
    if ( $server_faction ne '' ) {
      if ( /\["gold"\] = (\d+),/ ) {
        my $gold = ceil( $1 / 10000 );
        $gold{$server_faction} += $gold
          if $gold > $MinGold;
        $server_faction = '';
      } elsif ( /^\s*},/ ) {
        $server_faction = '';
      }
    }
  }
  die "$0: Failed to close '$file' - $!\n"
    unless close FILE;

  return %gold;
}

#-------------------------------------------------------------------------------
# read_columns
# Return the list of columns in the file being written
# For a brand new file we just return the list of keys in the hash
sub read_columns {
  my ($hr) = @_;
  return sort keys %$hr
    unless -f $Output;
  die "$0: Failed to open '$Output' for reading - $!"
    unless open FILE, $Output;
  my $line = ;
  chomp $line;
  die "$0: Failed to close '$Output' - $!"
    unless close FILE;
  die "$0: First line of '$Output' does not have expected data: '$line'\n"
    unless $line =~ /^Date\t+(.*)$/;
  my $cols = $1;
  return split /\t/, $cols;
}

#-------------------------------------------------------------------------------
# update_columns
# Do we need to add columns to the header?
sub update_columns {
  my ($column_count, @cols) = @_;
  return
    if @cols == 0;
  die "$0: Failed to open '$Output' for reading - $!"
    unless open FILE, $Output;
  my @lines = ();
  my $ln = 0;
  while() {
    chomp;
    $ln++;
    my $line = $_;
    if ( $ln == 1 ) {
      $line = join "\t", $_, @cols;
      Debug "Reset columns to be $line";
    } else {
      my @line_col = split /\t/;
      # line_col includes the date, so allow for that
      if ( ( @line_col - 1 ) == $column_count ) {
        Debug sprintf "Adding %d zero cols to line %d", scalar @cols, $ln;
        push @line_col, 0
          foreach (@cols);
        $line = join "\t", @line_col;
      }
    }
    push @lines, "$line\n";
  }
  die "$0: Failed to close '$Output' - $!"
    unless close FILE;

  die "$0: Failed to open '$Output' for writing - $!"
    unless open FILE, ">$Output";
  print FILE join '', @lines;
  die "$0: Failed to close '$Output' after writing - $!"
    unless close FILE;
}

#-------------------------------------------------------------------------------
# last_date
# What is the last date seen; returns an empty string if there is no file
sub last_date {
  return ''
    unless -f $Output;
  die "$0: Failed to open $Output for reading - $!"
    unless open FILE, $Output;
  my @lines = ;
  die "$0: Failed to close $Output - $!"
    unless close FILE;
  my $last = pop @lines;
  return ''
    unless $last =~ /^(\d{4}-\d{2}-\d{2})\t/;
  return $1;
}

#-------------------------------------------------------------------------------
# write_data
# Actually write the data out. This is somewhat "fun" as we need to keep the
# order of the columns sane. We may have an pre-existing file which will need
# to have the column order preserved.
sub write_data {
  my ($hr,$date) = @_;
  my @columns = read_columns $hr;
  if ( ! -f $Output ) {
    die "$0: Failed to open '$Output' for writing - $!\n"
      unless open FILE, ">$Output";
    print FILE join( "\t", 'Date', @columns ), "\n";
  } else {
    die "$0: Failed to open '$Output' for appending - $!\n"
      unless open FILE, ">>$Output";
  }
  my @output = ();
  # Go through the columns we know about - if they don't exist in the
  # hash then we put a zero value.
  # Once we've got the value in place we delete from the hash. Anything
  # left in the hash at the end means a new column
  foreach my $col (@columns) {
    if ( ! exists $hr->{$col} ) {
      Debug "Data for column '$col' not present - reset to 0";
      push @output, 0;
      next;
    }
    push @output, $hr->{$col};
    delete $hr->{$col};
  }

  my @new_cols = sort keys %$hr;
  foreach my $col (@new_cols) {
    Debug "New column '$col' added";
    push @output, $hr->{$col};
  }

  print FILE join( "\t", $date, @output ), "\n";
  close FILE;
  update_columns scalar @columns, @new_cols;
}

#-------------------------------------------------------------------------------
# sort_dates
# Helper to sort to sort a list of YYYY-MM-DD dates
sub sort_dates {
  return 0 if $a eq $b;
  my @list_a = split /-/, $a;
  my @list_b = split /-/, $b;
  while( @list_a ) {
    my $la = shift @list_a;
    my $lb = shift @list_b;
    next if $la == $lb;
    return $la  $lb;
  }
  return 0;
}

#-------------------------------------------------------------------------------
# Get the list of Time Machine dates. We use tmutil listbackups to get the list
# of backups available.
#
# We return a list of hashes, ordered by date. Each hash contains:
#   {
#     date => "YYYY-MM-DD"
#     dir  => Location
#   }
#
# tmutil listbackups returns back a list like:
#  /Volumes/TIMEMACHINE_VOL/Backups.backupdb/HOST/YYYY-MM-DD-HHMMSS
#
sub get_tm_dates {
  my %backups;
  die "$0: Failed to kick off tmutil - $!\n"
    unless open LIST, "tmutil listbackups|";
  while() {
    chomp;
    die "$0: Failed to parse line '$_'"
      unless /\/(\d{4}-\d{2}-\d{2})-(\d{2})(\d{4})$/;
    $backups{$1}->{$2}->{$3} = $_;
    
  }
  die "$0: Failed to shutdown after tmutil - $!\n"
    unless close LIST;
  die "$0: Non-zero exist code from tmutil\n"
    unless $? == 0;
  Debug Dumper \%backups;
  my @retval = ();
  my @dates = sort sort_dates keys %backups;
  foreach my $date (@dates) {
    next
      if $date eq $Date;
    my $date_hr = $backups{$date};
    my @hrs = keys %$date_hr;
    my $pick_hr;
    if ( exists $date_hr->{05} ) {
      $pick_hr = '05';
    } else {
      $pick_hr = $hrs[0];
    }
    my $min_hr = $date_hr->{$pick_hr};
    my @mins = sort {$b  $a} keys %$min_hr;
    my $min = $mins[ 0 ];
    push @retval, +{
        date => $date,
        dir  => $date_hr->{$pick_hr}->{$min},
      };
  }
  return @retval;
}

#-------------------------------------------------------------------------------
# backfill_data
# Use Time Machine to backfill the data
sub backfill_data {
  die "$0: Output file '$Output' already exists\n"
    if -f $Output;
  my @tm_dates = get_tm_dates;
  Debug Dumper \@tm_dates;
  foreach my $hr (@tm_dates) {
    my $path = join '/', $hr->{dir}, 'Macintosh HD', $DataFile;
    my $tmpfile = mktemp 'wowgold-backfill-XXXXX';
    my @cmd = (qw( tmutil restore ), $path, $tmpfile );
    Debug sprintf "Running %s", join ' ', @cmd;
    system @cmd;
    if ( $? == 0 ) {
      my %Data = parse_file $tmpfile;
      Debug Dumper \%Data;
      write_data \%Data, $hr->{date};
    } else {
      print STDERR "Non-zero exit code from ", join( ' ', @cmd ), " - skipping\n";
    }
    die "$0: Failed to remove tempfile $tmpfile - $!\n"
      unless unlink $tmpfile;
  }
}

#-------------------------------------------------------------------------------

$main::opt_h=undef;
$main::opt_d=undef;
$main::opt_B=undef;
$main::opt_D=undef;
$main::opt_f=undef;
$main::opt_d=undef;
$main::opt_o=undef;
$main::opt_g=undef;

getopts('hBDf:d:o:g:') || usage;

usage                     if $main::opt_h;
$Debug    = 1             if $main::opt_D;
$Backfill = 1             if $main::opt_B;
$DataFile = $main::opt_f  if $main::opt_f;
$Output   = $main::opt_o  if $main::opt_o;
if ( $main::opt_d ) {
  die "$0: Unexpected date string; want YYYY-MM-DD, not '$main::opt_D'\n"
    unless $main::opt_d =~ /^(\d{4})-(\d{2})-(\d{2})$/;
  die "$0: Month out of range; got '$1'\n"
    if $2 > 12;
  die "$0: Day out of range; got '$1'\n"
    if $3 > 31;
  $Date = $main::opt_d;
}
if ( $main::opt_g ) {
  die "$0: Invalid data '$main::opt_g'\n"
    unless $main::opt_g =~ /^\d+$/;
  $MinGold = $main::opt_g;
}

Debug "Reading from $DataFile";
Debug "Writing to   $Output";
Debug "Date used    $Date";

my $existing = last_date;
die "$0: Already have $Date set"
  if $Date eq $existing;
my @lst = sort sort_dates ( $Date, $existing );
die "$0: Given date '$Date' before last date '$existing'"
  if $lst[ 0 ] eq $Date;

backfill_data
  if $Backfill;

my %Data = parse_file $DataFile;
Debug Dumper \%Data;

write_data \%Data, $Date;

exit 0;