Difference between revisions of "User:Thickbrick Sleaford"

From Second Life Wiki
Jump to navigation Jump to search
Line 1: Line 1:
== SL Transaction Analyzer ==
== SL Transaction Analyzer ==


A perl script I've written, to help merchants make sense of their transaction histories.
A perl script I've written, to help merchants make sense of their transaction histories.
Scroll to the end of the script for a description of what it does.
Scroll to the end of the script for a description of what it does.
Copy and paste all the gray rectangles into a .pl file and run.
Copy and paste into a .pl file and run.
'''Use at your own risk'''.
'''Use at your own risk'''.
--[[User:Thickbrick Sleaford|Thickbrick Sleaford]] 15:47, 1 September 2008 (PDT)
--[[User:Thickbrick Sleaford|Thickbrick Sleaford]] 15:47, 1 September 2008 (PDT)
Line 11: Line 10:


'''Start copy from here'''
'''Start copy from here'''
#!/usr/bin/perl
<perl>
#
#!/usr/bin/perl
# Analyze a collection of SL transaction history XML files.
#
#
# Analyze a collection of SL transaction history XML files.
# Depends on libxml-simpleobject-perl (debian package). Only tested on Linux so far.
#
#
# Depends on libxml-simpleobject-perl (debian package). Only tested on Linux so far.
# Limitations: If there is a period that didn't have any sales in it,
#
# the resulting csv table will skip it.  Probably not secure.
# Limitations: If there is a period that didn't have any sales in it,
#
# the resulting csv table will skip it.  Probably not secure.
# Please report any bugs you find.
#
# License: GPL v3 or later, or Creative Commons Attribution-Share Alike 3.0
# Please report bugs to thickbrick.sleaford (at) gmail.com
#
# License: GPL v3 or later, or Creative Commons Attribution-Share Alike 3.0
#


use warnings;
use warnings;
use strict;
use strict;
use Getopt::Std;
use Getopt::Std;
use File::Temp qw(tempfile);
use File::Temp qw(tempfile);
use XML::SimpleObject;
use XML::SimpleObject;
use Time::Local;
use Time::Local;
use POSIX qw(strftime);
use POSIX qw(strftime);


$main::VERSION='0.1 (2008-08-27)';
$main::VERSION='0.1 (2008-08-27)';
$Getopt::Std::STANDARD_HELP_VERSION=1;
$Getopt::Std::STANDARD_HELP_VERSION=1;


sub read_files(@);
sub read_files(@);
sub read_ll_xml_file($);
sub read_ll_xml_file($);
sub read_slexchange_csv_file($);
sub read_slexchange_csv_file($);
sub totals_by_desc(\@\@);
sub totals_by_desc(\@\@);
sub print_csv($$);
sub print_csv($$);
sub rows_to_csv(\@);
sub rows_to_csv(\@);
sub row_total($);
sub row_total($);


my $oocalc_name='oocalc'; #the executable for OpenOffice Calc
my $oocalc_name='oocalc'; #the executable for OpenOffice Calc
my $slexchange_comission_percent=5.0;
my $slexchange_comission_percent=5.0;
my %transactions;
my %transactions;




#main:
#main:
if (@ARGV < 1) {
if (@ARGV < 1) {
main::VERSION_MESSAGE();
main::VERSION_MESSAGE();
main::HELP_MESSAGE();
main::HELP_MESSAGE();
} else {
} else {
my @in_files;
my @in_files;
my %options; #command line options
my %options; #command line options
my $split_period=7*24*3600;
my $split_period=7*24*3600;
my $temp_filename;
my $temp_filename;
my $outfile_handler;
my $outfile_handler;


#process command line options:
#process command line options:
getopts('co:p:', \%options);
getopts('co:p:', \%options);
if (exists $options{'p'} and defined $options{'p'}) {
if (exists $options{'p'} and defined $options{'p'}) {
$split_period = 24*3600 * $options{'p'};
$split_period = 24*3600 * $options{'p'};
} else {
} else {
$split_period = 24*3600*7;
$split_period = 24*3600*7;
}
}
if (exists $options{'c'}) {
if (exists $options{'c'}) {
($outfile_handler, $temp_filename) = tempfile(SUFFIX => '.csv'); #oocalc wants '.csv' suffix
($outfile_handler, $temp_filename) = tempfile(SUFFIX => '.csv'); #oocalc wants '.csv' suffix
open($outfile_handler,'>', $temp_filename) or die "\nCan't open temporary file '" . $temp_filename . "' for writing: $!\n";
open($outfile_handler,'>', $temp_filename) or die "\nCan't open temporary file '" . $temp_filename . "' for writing: $!\n";
} elsif (exists $options{'o'} and defined $options{'o'}) {
} elsif (exists $options{'o'} and defined $options{'o'}) {
if (-e $options{'o'}) {
if (-e $options{'o'}) {
die "\nOutput file '" . $options{'o'} . "' already exists. Will not try to overwrite it.\n\n";
die "\nOutput file '" . $options{'o'} . "' already exists. Will not try to overwrite it.\n\n";
} else {
} else {
open($outfile_handler,'>', $options{'o'}) or die "\nCan't open file '" . $options{'o'} . "' for writing: $!\n";
open($outfile_handler,'>', $options{'o'}) or die "\nCan't open file '" . $options{'o'} . "' for writing: $!\n";
}
}
}
}
#read input file(s)
#read input file(s)
@in_files=@ARGV;
@in_files=@ARGV;
if (@in_files < 1) {
if (@in_files < 1) {
die "\nNo input file specified.\nUse --help for more info.\n\n"
die "\nNo input file specified.\nUse --help for more info.\n\n"
}
}
read_files(@in_files);
read_files(@in_files);
#process/print output
#process/print output
print_csv($outfile_handler, $split_period);
print_csv($outfile_handler, $split_period);
#run openoffice calc if needed
#run openoffice calc if needed
if (exists $options{'c'}) {
if (exists $options{'c'}) {
system($oocalc_name, $temp_filename) == 0 or die "\nCan't execute OpenOffice Calc: '$oocalc_name'.\n\n";
system($oocalc_name, $temp_filename) == 0 or die "\nCan't execute OpenOffice Calc: '$oocalc_name'.\n\n";
}
}
close($outfile_handler) if defined $outfile_handler;
close($outfile_handler) if defined $outfile_handler;
print "\n";
print "\n";
}
}




#read xml files and store in a hash ref
#read xml files and store in a hash ref
sub read_files (@) {
sub read_files (@) {
print STDERR "\n";
print STDERR "\n";
foreach my $file (@_) {
foreach my $file (@_) {
my $fh;
my $fh;
open $fh, '<', $file or die "Can't open file '$file': $!\n";
open $fh, '<', $file or die "Can't open file '$file': $!\n";
my $first_line=<$fh>;
my $first_line=<$fh>;
if ($first_line =~ m/<\?xml version="1.0" \?>/) {
if ($first_line =~ m/<\?xml version="1.0" \?>/) {
read_ll_xml_file($file);
read_ll_xml_file($file);
} else {
} else {
#assume it's an slexchange csv file
#assume it's an slexchange csv file
read_slexchange_csv_file($file);
read_slexchange_csv_file($file);
}
}
}
}
my $num = keys %transactions;
my $num = keys %transactions;
print STDERR "Total unique sales processed: $num.\n";
print STDERR "Total unique sales processed: $num.\n";
print STDERR "\n";
print STDERR "\n";
}
}


# read an SL transactions xml file and add it to the global hash
# read an SL transactions xml file and add it to the global hash
sub read_ll_xml_file($) {
sub read_ll_xml_file($) {
my $file = shift or return;
my $file = shift or return;
my $gmt_to_slt = (-7)*3600; #SLT is 'America/Los_Angeles' (-0700). TODO: find the proper way to do this.
my $gmt_to_slt = (-7)*3600; #SLT is 'America/Los_Angeles' (-0700). TODO: find the proper way to do this.
print STDERR "Reading LL XML file: \'$file\' ... ";
print STDERR "Reading LL XML file: \'$file\' ... ";
my $added=0;
my $added=0;
my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree");
my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree");
my $xso = XML::SimpleObject->new( $parser->parsefile($file) );
my $xso = XML::SimpleObject->new( $parser->parsefile($file) );


foreach my $transaction ($xso->child('transactions')->children) {
foreach my $transaction ($xso->child('transactions')->children) {
#begin by filtering for interesting transaction only (object sales and payments that are also deposits):
#begin by filtering for interesting transaction only (object sales and payments that are also deposits):
if ($transaction->child('deposit') and $transaction->child('deposit')->value ne ''
if ($transaction->child('deposit') and $transaction->child('deposit')->value ne ''
and $transaction->child('type') and ($transaction->child('type')->value eq 'Payment' or
and $transaction->child('type') and ($transaction->child('type')->value eq 'Payment' or
$transaction->child('type')->value eq 'Object Sale'))
$transaction->child('type')->value eq 'Object Sale'))
{
{
#store the (hash-ref) transaction in the global hash if it has unique id
#store the (hash-ref) transaction in the global hash if it has unique id
my $t_id = $transaction->child('id') ? $transaction->child('id')->value : '';
my $t_id = $transaction->child('id') ? $transaction->child('id')->value : '';
my $t;
my $t;
$t->{'price'} = $transaction->child('deposit') ? $transaction->child('deposit')->value : '';
$t->{'price'} = $transaction->child('deposit') ? $transaction->child('deposit')->value : '';
$t->{'description'} = $transaction->child('description') ? $transaction->child('description')->value : '';
$t->{'description'} = $transaction->child('description') ? $transaction->child('description')->value : '';
my $time = $transaction->child('time') ? $transaction->child('time')->value : '';
my $time = $transaction->child('time') ? $transaction->child('time')->value : '';
my @time_l = split /[- :]/,$time;
my @time_l = split /[- :]/,$time;
$time_l[1]-=1; #if int $time_l[1] > 0; #timelocal thinks januaray is month 0, not 1;
$time_l[1]-=1; #if int $time_l[1] > 0; #timelocal thinks januaray is month 0, not 1;
# (SL transactions are written in SLT/PST. this converts to gmt)
# (SL transactions are written in SLT/PST. this converts to gmt)
$t->{'time'} = (timelocal reverse @time_l) - $gmt_to_slt;
$t->{'time'} = (timelocal reverse @time_l) - $gmt_to_slt;
if (not exists $transactions{$t_id})  {
if (not exists $transactions{$t_id})  {
$transactions{$t_id}=$t;
$transactions{$t_id}=$t;
++$added;
++$added;
}
}
}
}
}
}
print STDERR " $added unique sales added.\n";
print STDERR " $added unique sales added.\n";
}
}


# read an slexchange.com transactions csv file and add it to the global hash
# read an slexchange.com transactions csv file and add it to the global hash
# the CSV is : ID, Date, Type, Transaction_Description, Amount, Balance
# the CSV is : ID, Date, Type, Transaction_Description, Amount, Balance
sub read_slexchange_csv_file($) {
sub read_slexchange_csv_file($) {
my $file = shift or return;
my $file = shift or return;
my $gmt_to_slt = (-7)*3600; #SLT is 'America/Los_Angeles' (-0700). TODO: find the proper way to do this.
my $gmt_to_slt = (-7)*3600; #SLT is 'America/Los_Angeles' (-0700). TODO: find the proper way to do this.
my $added=0;
my $added=0;
my $fh;
my $fh;
open $fh, '<', $file or die "Can't open file '$file': $!\n";
open $fh, '<', $file or die "Can't open file '$file': $!\n";
print STDERR "Reading SLExchange CSV file: \'$file\' ... ";
print STDERR "Reading SLExchange CSV file: \'$file\' ... ";
my $discard_line = <$fh>; #discard first line;
my $discard_line = <$fh>; #discard first line;
while (<$fh>) {
while (<$fh>) {
my ($t_id, $time, $type, $desc, $amount, $balance)=split(/,/);
my ($t_id, $time, $type, $desc, $amount, $balance)=split(/,/);
#create a hash ref;
#create a hash ref;
my $t;
my $t;
$amount = $amount ? $amount : 0;
$amount = $amount ? $amount : 0;
$amount *= (1 - ($slexchange_comission_percent/100)); #substract slex comission
$amount *= (1 - ($slexchange_comission_percent/100)); #substract slex comission
$t->{'price'}= sprintf("%.0f", $amount); #round it
$t->{'price'}= sprintf("%.0f", $amount); #round it
$t->{'description'} = $desc ? $desc : '';
$t->{'description'} = $desc ? $desc : '';
my @time_l = split /[- :]/,($time ? $time : '');
my @time_l = split /[- :]/,($time ? $time : '');
$time_l[1] -= 1; #if int $time_l[1] > 0; #timelocal thinks januaray is month 0, not 1;
$time_l[1] -= 1; #if int $time_l[1] > 0; #timelocal thinks januaray is month 0, not 1;
# (SL transactions are written in SLT/PST. this converts to gmt)
# (SL transactions are written in SLT/PST. this converts to gmt)
$t->{'time'} = (timelocal reverse @time_l) - $gmt_to_slt;
$t->{'time'} = (timelocal reverse @time_l) - $gmt_to_slt;
if ($type eq '"SLL Item Purchase"' and $amount > 0 and $t_id ne '' and $desc ne '') {
if ($type eq '"SLL Item Purchase"' and $amount > 0 and $t_id ne '' and $desc ne '') {
$t_id='SLEX' . $t_id; #make sure ids don't collide with LL transaction ids
$t_id='SLEX' . $t_id; #make sure ids don't collide with LL transaction ids
#add hasref to global hash if unique:
#add hasref to global hash if unique:
if (not exists $transactions{$t_id})  {
if (not exists $transactions{$t_id})  {
$transactions{$t_id}=$t;
$transactions{$t_id}=$t;
++$added;
++$added;
}
}
}
}
}
}
print STDERR " $added unique sales added.\n";
print STDERR " $added unique sales added.\n";
}
}




#Accepts 2 array refs, unique descriptions, transaction ids.
#Accepts 2 array refs, unique descriptions, transaction ids.
#returns 2 lists, units sold per each description, and L$ sums per description
#returns 2 lists, units sold per each description, and L$ sums per description
sub totals_by_desc(\@\@) {
sub totals_by_desc(\@\@) {
my ($aref_descs, $aref_tids) = @_;
my ($aref_descs, $aref_tids) = @_;
my $items;
my $items;
my @units;
my @units;
my @sums;
my @sums;
# go over all ids and create a
# go over all ids and create a
# hash ref of: tids->descriptions->totals:
# hash ref of: tids->descriptions->totals:
foreach my $tid (@{$aref_tids}) {
foreach my $tid (@{$aref_tids}) {
my $t=$transactions{$tid};
my $t=$transactions{$tid};
if (defined $t->{'description'}) {
if (defined $t->{'description'}) {
if (exists $items->{$t->{'description'}}) {
if (exists $items->{$t->{'description'}}) {
$items->{$t->{'description'}}->{'sum'} += $t->{'price'};
$items->{$t->{'description'}}->{'sum'} += $t->{'price'};
$items->{$t->{'description'}}->{'units'} += 1;
$items->{$t->{'description'}}->{'units'} += 1;
} else {
} else {
$items->{$t->{'description'}}->{'sum'} = $t->{'price'};
$items->{$t->{'description'}}->{'sum'} = $t->{'price'};
$items->{$t->{'description'}}->{'units'} = 1;
$items->{$t->{'description'}}->{'units'} = 1;
}
}
}
}
}
}
# go over all descriptions and make a list of totals
# go over all descriptions and make a list of totals
foreach my $desc (@{$aref_descs}) {
foreach my $desc (@{$aref_descs}) {
if (exists $items->{$desc}) {
if (exists $items->{$desc}) {
push @sums, $items->{$desc}->{'sum'};
push @sums, $items->{$desc}->{'sum'};
push @units, $items->{$desc}->{'units'};
push @units, $items->{$desc}->{'units'};
} else {
} else {
push @sums, 0;
push @sums, 0;
push @units, 0;
push @units, 0;
}
}
}
}
return \@sums, \@units;
return \@sums, \@units;
}
}




# accept and array of refs to row arrays
# accept and array of refs to row arrays
# return a csv string of the rows
# return a csv string of the rows
sub rows_to_csv(\@) {
sub rows_to_csv(\@) {
my $aref_row_refs = shift;
my $aref_row_refs = shift;
my $output='';
my $output='';
foreach my $row (@{$aref_row_refs}) {
foreach my $row (@{$aref_row_refs}) {
$output .= join (',', @$row) . ",\n";
$output .= join (',', @$row) . ",\n";
}
}
return $output;
return $output;
}
}


#accepts a ref to an array (row), returns the sum of the items in the arra
#accepts a ref to an array (row), returns the sum of the items in the arra
sub row_total($) {
sub row_total($) {
my $aref_row=shift;
my $aref_row=shift;
my $total = 0;
my $total = 0;
foreach (@{$aref_row}) {
foreach (@{$aref_row}) {
$total += $_;
$total += $_;
}
}
return $total;
return $total;
}
}


#print csv totals seperated to different tables, per period (in seconds)
#print csv totals seperated to different tables, per period (in seconds)
sub print_csv($$) {
sub print_csv($$) {
my $file_desc = shift;
my $file_desc = shift;
my $duration = shift or 0; #duration of each period
my $duration = shift or 0; #duration of each period
my $output='';
my $output='';
my $periods; #hash of arrays or transaction ids
my $periods; #hash of arrays or transaction ids
my %all_seen_descriptions; #keeps all seen descriptions, since not all will appear in a given period
my %all_seen_descriptions; #keeps all seen descriptions, since not all will appear in a given period
my $items;
my $items;
#order by periods:
#order by periods:
foreach my $tid (keys %transactions) {
foreach my $tid (keys %transactions) {
my $t=$transactions{$tid};
my $t=$transactions{$tid};
if (defined $t->{'time'}) {
if (defined $t->{'time'}) {
#store the transaction id in an array, which is stored in a hash to the relevant period:
#store the transaction id in an array, which is stored in a hash to the relevant period:
#if no duration, use time()+1dascalar.htmly as duration, to make sure only 1 period will be stored
#if no duration, use time()+1dascalar.htmly as duration, to make sure only 1 period will be stored
my $period = $duration ? int ($t->{'time'} / $duration) : time()+(24*3600);
my $period = $duration ? int ($t->{'time'} / $duration) : time()+(24*3600);
push @{$periods->{$period}}, $tid;
push @{$periods->{$period}}, $tid;
}
}
#if we haven't seen this description before, remember it:
#if we haven't seen this description before, remember it:
if (defined $t->{'description'}) {
if (defined $t->{'description'}) {
if (not exists $all_seen_descriptions{$t->{'description'}}) {
if (not exists $all_seen_descriptions{$t->{'description'}}) {
$all_seen_descriptions{$t->{'description'}}='';
$all_seen_descriptions{$t->{'description'}}='';
}
}
}
}
}
}
my @descs_arr =  sort keys %all_seen_descriptions;
my @descs_arr =  sort keys %all_seen_descriptions;
my @periods_arr = sort keys %{$periods};
my @periods_arr = sort keys %{$periods};
#my @descs_arr =  sort keys %all_seen_descriptions;
#my @descs_arr =  sort keys %all_seen_descriptions;
print STDERR 'Total unique sale descriptions: ' . @descs_arr . "\n";
print STDERR 'Total unique sale descriptions: ' . @descs_arr . "\n";
print STDERR 'Total periods (' . (int $duration)/(24*3600) . ' days): ' . @periods_arr . "\n\n";
print STDERR 'Total periods (' . (int $duration)/(24*3600) . ' days): ' . @periods_arr . "\n\n";


#prepare each period's totals:
#prepare each period's totals:
my @sums_row_refs;
my @sums_row_refs;
my @units_row_refs;
my @units_row_refs;
foreach my $period (@periods_arr) {
foreach my $period (@periods_arr) {
my $start = strftime "%Y-%b-%d", localtime((int $period) * int $duration);
my $start = strftime "%Y-%b-%d", localtime((int $period) * int $duration);
my ($sums_row_ref, $units_row_ref) = totals_by_desc(@descs_arr, @{$periods->{$period}});
my ($sums_row_ref, $units_row_ref) = totals_by_desc(@descs_arr, @{$periods->{$period}});
#add totals and start, and convert to real array;
#add totals and start, and convert to real array;
my @sums_row = ($start, @{$sums_row_ref}, row_total($sums_row_ref));
my @sums_row = ($start, @{$sums_row_ref}, row_total($sums_row_ref));
my @units_row = ($start, @{$units_row_ref} , row_total($units_row_ref));
my @units_row = ($start, @{$units_row_ref} , row_total($units_row_ref));
#add row to rows collections:
#add row to rows collections:
push @sums_row_refs, \@sums_row;
push @sums_row_refs, \@sums_row;
push @units_row_refs, \@units_row;
push @units_row_refs, \@units_row;
}
}


$output .= "SL Sales (all times in SLT)\n\nSales over time (L\$ sum)\n";
$output .= "SL Sales (all times in SLT)\n\nSales over time (L\$ sum)\n";
$output .= "Period (" . (int $duration)/(24*3600) . " days starting with),";
$output .= "Period (" . (int $duration)/(24*3600) . " days starting with),";
$output .= join(',', @descs_arr) . ",Total,\n"; #column heads:
$output .= join(',', @descs_arr) . ",Total,\n"; #column heads:
$output .= rows_to_csv(@sums_row_refs);
$output .= rows_to_csv(@sums_row_refs);


$output .= "\n\nSales over time (units sold)\n";
$output .= "\n\nSales over time (units sold)\n";
$output .= "Period (" . (int $duration)/(24*3600) . " days starting with),";
$output .= "Period (" . (int $duration)/(24*3600) . " days starting with),";
$output .= join(',', @descs_arr) . ",Total,\n";
$output .= join(',', @descs_arr) . ",Total,\n";
$output .= rows_to_csv(@units_row_refs);
$output .= rows_to_csv(@units_row_refs);


#print to STDOUT or file:
#print to STDOUT or file:
if (defined $file_desc) {
if (defined $file_desc) {
print $file_desc $output;
print $file_desc $output;
} else {
} else {
print $output;
print $output;
}
}
}
}


sub main::VERSION_MESSAGE {
sub main::VERSION_MESSAGE {
print "  SL transactions analyzer version $main::VERSION.\n";
print "  SL transactions analyzer version $main::VERSION.\n";
  print '  Written by Thickbrick Sleaford <thickbrick.sleaford (at) gmail.com>.' . "\n";
print '  Written by Thickbrick Sleaford <thickbrick.sleaford (at) gmail.com>.' . "\n";
  print "  License: GPL v3 or later, or Creative Commons Attribution-Share Alike 3.0.\n";
print "  License: GPL v3 or later, or Creative Commons Attribution-Share Alike 3.0.\n";
}
}


sub main::HELP_MESSAGE {
sub main::HELP_MESSAGE {
my $help = <<END;
my $help = <<END;


  Run this program with a list of Transaction History files as arguments.
  Run this program with a list of Transaction History files as arguments.
  It will extract transactions from the files, get rid of duplicates, remove
  It will extract transactions from the files, get rid of duplicates, remove
  transactions that aren't sales by you (Object Payment and Object Sale) and
  transactions that aren't sales by you (Object Payment and Object Sale) and
  aggregate them by weeks.  The result is comma seperated values (csv).
  aggregate them by weeks.  The result is comma seperated values (csv).
  Supports LL XML files and slexchange CSV files.
  Supports LL XML files and slexchange CSV files.


  transactions.pl [-p <days>] [-c] [-o <output_file>] <input_file1> [<input_file2> <input_file3>..]
  transactions.pl [-p <days>] [-c] [-o <output_file>] <input_file1> [<input_file2> <input_file3>..]


    -p <days>
    -p <days>
      Aggregate sales in periods of this length days (integer).
      Aggregate sales in periods of this length days (integer).
      Default is 7 Days.
      Default is 7 Days.


    -c
    -c
      Open the resulting CSV with OpenOffice Calc
      Save the resulting CSV in a temporary file and open it with OpenOffice Calc


    -o <output_file>
    -o <output_file>
      Save the resulting CSV to a file.
      Save the resulting CSV to a file.
      Use caution not to overwrite an input file!
      Use caution not to overwrite an input file!


    --help
    --help
      This helpful messages.
      This helpful messages.


END
END
print $help;
print $help;


}
}


</perl>
'''End copy here'''
'''End copy here'''

Revision as of 15:23, 1 September 2008

SL Transaction Analyzer

A perl script I've written, to help merchants make sense of their transaction histories. Scroll to the end of the script for a description of what it does. Copy and paste into a .pl file and run. Use at your own risk. --Thickbrick Sleaford 15:47, 1 September 2008 (PDT)


Start copy from here <perl>

  1. !/usr/bin/perl
  2. Analyze a collection of SL transaction history XML files.
  3. Depends on libxml-simpleobject-perl (debian package). Only tested on Linux so far.
  4. Limitations: If there is a period that didn't have any sales in it,
  5. the resulting csv table will skip it. Probably not secure.
  6. Please report bugs to thickbrick.sleaford (at) gmail.com
  7. License: GPL v3 or later, or Creative Commons Attribution-Share Alike 3.0

use warnings; use strict; use Getopt::Std; use File::Temp qw(tempfile); use XML::SimpleObject; use Time::Local; use POSIX qw(strftime);

$main::VERSION='0.1 (2008-08-27)'; $Getopt::Std::STANDARD_HELP_VERSION=1;

sub read_files(@); sub read_ll_xml_file($); sub read_slexchange_csv_file($); sub totals_by_desc(\@\@); sub print_csv($$); sub rows_to_csv(\@); sub row_total($);

my $oocalc_name='oocalc'; #the executable for OpenOffice Calc my $slexchange_comission_percent=5.0; my %transactions;


  1. main:

if (@ARGV < 1) { main::VERSION_MESSAGE(); main::HELP_MESSAGE(); } else { my @in_files; my %options; #command line options my $split_period=7*24*3600; my $temp_filename; my $outfile_handler;

  1. process command line options:

getopts('co:p:', \%options); if (exists $options{'p'} and defined $options{'p'}) { $split_period = 24*3600 * $options{'p'}; } else { $split_period = 24*3600*7; } if (exists $options{'c'}) { ($outfile_handler, $temp_filename) = tempfile(SUFFIX => '.csv'); #oocalc wants '.csv' suffix open($outfile_handler,'>', $temp_filename) or die "\nCan't open temporary file '" . $temp_filename . "' for writing: $!\n"; } elsif (exists $options{'o'} and defined $options{'o'}) { if (-e $options{'o'}) { die "\nOutput file '" . $options{'o'} . "' already exists. Will not try to overwrite it.\n\n"; } else { open($outfile_handler,'>', $options{'o'}) or die "\nCan't open file '" . $options{'o'} . "' for writing: $!\n"; } }

  1. read input file(s)

@in_files=@ARGV; if (@in_files < 1) { die "\nNo input file specified.\nUse --help for more info.\n\n" } read_files(@in_files);

  1. process/print output

print_csv($outfile_handler, $split_period);

  1. run openoffice calc if needed

if (exists $options{'c'}) { system($oocalc_name, $temp_filename) == 0 or die "\nCan't execute OpenOffice Calc: '$oocalc_name'.\n\n"; } close($outfile_handler) if defined $outfile_handler; print "\n"; }


  1. read xml files and store in a hash ref

sub read_files (@) { print STDERR "\n"; foreach my $file (@_) { my $fh; open $fh, '<', $file or die "Can't open file '$file': $!\n"; my $first_line=<$fh>; if ($first_line =~ m/<\?xml version="1.0" \?>/) { read_ll_xml_file($file); } else { #assume it's an slexchange csv file read_slexchange_csv_file($file); } } my $num = keys %transactions; print STDERR "Total unique sales processed: $num.\n"; print STDERR "\n"; }

  1. read an SL transactions xml file and add it to the global hash

sub read_ll_xml_file($) { my $file = shift or return; my $gmt_to_slt = (-7)*3600; #SLT is 'America/Los_Angeles' (-0700). TODO: find the proper way to do this. print STDERR "Reading LL XML file: \'$file\' ... "; my $added=0; my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree"); my $xso = XML::SimpleObject->new( $parser->parsefile($file) );

foreach my $transaction ($xso->child('transactions')->children) { #begin by filtering for interesting transaction only (object sales and payments that are also deposits): if ($transaction->child('deposit') and $transaction->child('deposit')->value ne and $transaction->child('type') and ($transaction->child('type')->value eq 'Payment' or $transaction->child('type')->value eq 'Object Sale')) { #store the (hash-ref) transaction in the global hash if it has unique id my $t_id = $transaction->child('id') ? $transaction->child('id')->value : ; my $t; $t->{'price'} = $transaction->child('deposit') ? $transaction->child('deposit')->value : ; $t->{'description'} = $transaction->child('description') ? $transaction->child('description')->value : ; my $time = $transaction->child('time') ? $transaction->child('time')->value : ; my @time_l = split /[- :]/,$time; $time_l[1]-=1; #if int $time_l[1] > 0; #timelocal thinks januaray is month 0, not 1; # (SL transactions are written in SLT/PST. this converts to gmt) $t->{'time'} = (timelocal reverse @time_l) - $gmt_to_slt; if (not exists $transactions{$t_id}) { $transactions{$t_id}=$t; ++$added; } } } print STDERR " $added unique sales added.\n"; }

  1. read an slexchange.com transactions csv file and add it to the global hash
  2. the CSV is : ID, Date, Type, Transaction_Description, Amount, Balance

sub read_slexchange_csv_file($) { my $file = shift or return; my $gmt_to_slt = (-7)*3600; #SLT is 'America/Los_Angeles' (-0700). TODO: find the proper way to do this. my $added=0; my $fh; open $fh, '<', $file or die "Can't open file '$file': $!\n"; print STDERR "Reading SLExchange CSV file: \'$file\' ... "; my $discard_line = <$fh>; #discard first line; while (<$fh>) { my ($t_id, $time, $type, $desc, $amount, $balance)=split(/,/); #create a hash ref; my $t; $amount = $amount ? $amount : 0; $amount *= (1 - ($slexchange_comission_percent/100)); #substract slex comission $t->{'price'}= sprintf("%.0f", $amount); #round it $t->{'description'} = $desc ? $desc : ; my @time_l = split /[- :]/,($time ? $time : ); $time_l[1] -= 1; #if int $time_l[1] > 0; #timelocal thinks januaray is month 0, not 1; # (SL transactions are written in SLT/PST. this converts to gmt) $t->{'time'} = (timelocal reverse @time_l) - $gmt_to_slt; if ($type eq '"SLL Item Purchase"' and $amount > 0 and $t_id ne and $desc ne ) { $t_id='SLEX' . $t_id; #make sure ids don't collide with LL transaction ids #add hasref to global hash if unique: if (not exists $transactions{$t_id}) { $transactions{$t_id}=$t; ++$added; } } } print STDERR " $added unique sales added.\n"; }


  1. Accepts 2 array refs, unique descriptions, transaction ids.
  2. returns 2 lists, units sold per each description, and L$ sums per description

sub totals_by_desc(\@\@) { my ($aref_descs, $aref_tids) = @_; my $items; my @units; my @sums; # go over all ids and create a # hash ref of: tids->descriptions->totals: foreach my $tid (@{$aref_tids}) { my $t=$transactions{$tid}; if (defined $t->{'description'}) { if (exists $items->{$t->{'description'}}) { $items->{$t->{'description'}}->{'sum'} += $t->{'price'}; $items->{$t->{'description'}}->{'units'} += 1; } else { $items->{$t->{'description'}}->{'sum'} = $t->{'price'}; $items->{$t->{'description'}}->{'units'} = 1; } } } # go over all descriptions and make a list of totals foreach my $desc (@{$aref_descs}) { if (exists $items->{$desc}) { push @sums, $items->{$desc}->{'sum'}; push @units, $items->{$desc}->{'units'}; } else { push @sums, 0; push @units, 0; } } return \@sums, \@units; }


  1. accept and array of refs to row arrays
  2. return a csv string of the rows

sub rows_to_csv(\@) { my $aref_row_refs = shift; my $output=; foreach my $row (@{$aref_row_refs}) { $output .= join (',', @$row) . ",\n"; } return $output; }

  1. accepts a ref to an array (row), returns the sum of the items in the arra

sub row_total($) { my $aref_row=shift; my $total = 0; foreach (@{$aref_row}) { $total += $_; } return $total; }

  1. print csv totals seperated to different tables, per period (in seconds)

sub print_csv($$) { my $file_desc = shift; my $duration = shift or 0; #duration of each period my $output=; my $periods; #hash of arrays or transaction ids my %all_seen_descriptions; #keeps all seen descriptions, since not all will appear in a given period my $items; #order by periods: foreach my $tid (keys %transactions) { my $t=$transactions{$tid}; if (defined $t->{'time'}) { #store the transaction id in an array, which is stored in a hash to the relevant period:

  1. if no duration, use time()+1dascalar.htmly as duration, to make sure only 1 period will be stored

my $period = $duration ? int ($t->{'time'} / $duration) : time()+(24*3600); push @{$periods->{$period}}, $tid; } #if we haven't seen this description before, remember it: if (defined $t->{'description'}) { if (not exists $all_seen_descriptions{$t->{'description'}}) { $all_seen_descriptions{$t->{'description'}}=; } } } my @descs_arr = sort keys %all_seen_descriptions; my @periods_arr = sort keys %{$periods}; #my @descs_arr = sort keys %all_seen_descriptions; print STDERR 'Total unique sale descriptions: ' . @descs_arr . "\n"; print STDERR 'Total periods (' . (int $duration)/(24*3600) . ' days): ' . @periods_arr . "\n\n";

#prepare each period's totals: my @sums_row_refs; my @units_row_refs; foreach my $period (@periods_arr) { my $start = strftime "%Y-%b-%d", localtime((int $period) * int $duration); my ($sums_row_ref, $units_row_ref) = totals_by_desc(@descs_arr, @{$periods->{$period}}); #add totals and start, and convert to real array; my @sums_row = ($start, @{$sums_row_ref}, row_total($sums_row_ref)); my @units_row = ($start, @{$units_row_ref} , row_total($units_row_ref)); #add row to rows collections: push @sums_row_refs, \@sums_row; push @units_row_refs, \@units_row; }

$output .= "SL Sales (all times in SLT)\n\nSales over time (L\$ sum)\n"; $output .= "Period (" . (int $duration)/(24*3600) . " days starting with),"; $output .= join(',', @descs_arr) . ",Total,\n"; #column heads: $output .= rows_to_csv(@sums_row_refs);

$output .= "\n\nSales over time (units sold)\n"; $output .= "Period (" . (int $duration)/(24*3600) . " days starting with),"; $output .= join(',', @descs_arr) . ",Total,\n"; $output .= rows_to_csv(@units_row_refs);

#print to STDOUT or file: if (defined $file_desc) { print $file_desc $output; } else { print $output; } }

sub main::VERSION_MESSAGE { print " SL transactions analyzer version $main::VERSION.\n";

	print '  Written by Thickbrick Sleaford <thickbrick.sleaford (at) gmail.com>.' . "\n";
	print "  License: GPL v3 or later, or Creative Commons Attribution-Share Alike 3.0.\n";

}

sub main::HELP_MESSAGE { my $help = <<END;

 Run this program with a list of Transaction History files as arguments.
 It will extract transactions from the files, get rid of duplicates, remove
 transactions that aren't sales by you (Object Payment and Object Sale) and
 aggregate them by weeks.  The result is comma seperated values (csv).
 Supports LL XML files and slexchange CSV files.
 transactions.pl [-p <days>] [-c] [-o <output_file>] <input_file1> [<input_file2> <input_file3>..]
   -p <days>
     Aggregate sales in periods of this length days (integer).
     Default is 7 Days.
   -c
     Save the resulting CSV in a temporary file and open it with OpenOffice Calc
   -o <output_file>
     Save the resulting CSV to a file.
     Use caution not to overwrite an input file!
   --help
     This helpful messages.

END print $help;

}

</perl> End copy here