Files: f1521af2d73e96acaa4e96dfc60dbfc50373845a / merge-ledger
6547 bytesRaw
| 1 | #!/usr/bin/env perl |
| 2 | |
| 3 | use strict; |
| 4 | use warnings; |
| 5 | use Time::Piece; |
| 6 | use Time::Seconds 'ONE_DAY'; |
| 7 | |
| 8 | $| = 1; |
| 9 | |
| 10 | my @files; |
| 11 | my @buffer; |
| 12 | my $buffer_size = 100; |
| 13 | |
| 14 | # acceptable time difference to consider transactions matching |
| 15 | my $time_difference = 7 * ONE_DAY; |
| 16 | |
| 17 | my $dateformat = "%Y/%m/%d"; |
| 18 | |
| 19 | if ($#ARGV == -1) { |
| 20 | print STDERR "Usage: $0 [-o merged-journal.ledger] [journal.ledger]...\n"; |
| 21 | exit 1; |
| 22 | } |
| 23 | |
| 24 | my @in_filenames; |
| 25 | my $out_filename; |
| 26 | |
| 27 | my $editor = $ENV{EDITOR} // 'vi +"norm zR"'; |
| 28 | |
| 29 | while (@ARGV) { |
| 30 | my $arg = shift; |
| 31 | if ($arg eq '-o') { |
| 32 | $out_filename = shift; |
| 33 | } else { |
| 34 | push @in_filenames, $arg; |
| 35 | } |
| 36 | } |
| 37 | |
| 38 | if ($out_filename) { |
| 39 | open OUTFILE, '>', $out_filename; |
| 40 | OUTFILE->autoflush(1); |
| 41 | } else { |
| 42 | open OUTFILE, '>&STDOUT'; |
| 43 | } |
| 44 | |
| 45 | sub read_entry { |
| 46 | my $fh = shift; |
| 47 | return if !defined $fh or eof $fh; |
| 48 | |
| 49 | my $amounts = {}; |
| 50 | my $lines = []; |
| 51 | my $entry = { |
| 52 | lines => $lines, |
| 53 | amounts => $amounts, |
| 54 | fh => $fh, |
| 55 | }; |
| 56 | |
| 57 | # Read lines until found entry date |
| 58 | while(1) { |
| 59 | my $line = <$fh>; |
| 60 | unless (defined $line) { |
| 61 | # fh is closed |
| 62 | return; |
| 63 | } |
| 64 | push @$lines, $line; |
| 65 | if ($line =~ /^([0-9]{4}\/[0-9]{1,2}\/[0-9]{1,2})/) { |
| 66 | # Make the date string lexically comparable |
| 67 | $entry->{date} = Time::Piece->strptime($1, $dateformat) or die("$!"); |
| 68 | last; |
| 69 | } |
| 70 | } |
| 71 | |
| 72 | # Read until reaching a blank line |
| 73 | while(1) { |
| 74 | my $line = <$fh>; |
| 75 | unless (defined $line) { |
| 76 | # fh is closed |
| 77 | push @$lines, "\n"; |
| 78 | return $entry; |
| 79 | } |
| 80 | push @$lines, $line; |
| 81 | return $entry if $line =~ /^$/; |
| 82 | # Record item amounts |
| 83 | if ($line =~ /^\s*[^;].*?(?:\s\s|\t)\s*[^@ ]*? ?[^ 0-9]?-?([0-9.,]+)0*[^@]*?\s+(?:;.*|@.*)?$/) { |
| 84 | # Account 35.0 BTC @ $15.19 |
| 85 | $amounts->{+$1} = 1; |
| 86 | } |
| 87 | } |
| 88 | |
| 89 | return $entry; |
| 90 | } |
| 91 | |
| 92 | sub print_entry { |
| 93 | my ($stream, $entry) = @_; |
| 94 | #$stream //= \*STDOUT; |
| 95 | #print $stream "fh: ".($entry->{fh} // 'null').". i: ".$entry->{buffer_i}."\n"; |
| 96 | print $_ . ", " for keys($entry->{amounts}); |
| 97 | print "\n"; |
| 98 | print $stream $_ for @{ $entry->{lines} }; |
| 99 | } |
| 100 | |
| 101 | sub get_oldest_entry { |
| 102 | return unless scalar @buffer; |
| 103 | |
| 104 | # pick the oldest entry |
| 105 | my $oldest = $buffer[0]; |
| 106 | for my $entry (@buffer[1..$#buffer]) { |
| 107 | if ($entry->{date} < $oldest->{date}) { |
| 108 | $oldest = $entry; |
| 109 | } |
| 110 | } |
| 111 | |
| 112 | return $oldest; |
| 113 | } |
| 114 | |
| 115 | sub entry_matches_date { |
| 116 | my ($entry, $date) = @_; |
| 117 | my $diff = $date - $entry->{date}; |
| 118 | printf("%s, %s: %s days\n", $date, $entry->{date}, $diff->days); |
| 119 | return (abs($diff) < $time_difference); |
| 120 | } |
| 121 | |
| 122 | sub entry_matches_amounts { |
| 123 | my ($entry, $amounts) = @_; |
| 124 | # require at least half of the amounts from entry to be present in amounts |
| 125 | my @amounts2 = keys $entry->{amounts}; |
| 126 | my $matched = 0; |
| 127 | for my $amt (@amounts2) { |
| 128 | $matched++ if $amounts->{$amt}; |
| 129 | } |
| 130 | return ($matched / scalar @amounts2) >= 0.5; |
| 131 | } |
| 132 | |
| 133 | sub find_matching_entries { |
| 134 | my $entry = shift; |
| 135 | my $date = $entry->{date}; |
| 136 | my $amounts = $entry->{amounts}; |
| 137 | my $fh = $entry->{fh}; |
| 138 | my @matches = grep { |
| 139 | defined $_ and |
| 140 | $fh != $_->{fh} and |
| 141 | entry_matches_date($_, $date) and |
| 142 | entry_matches_amounts($_, $amounts) |
| 143 | } @buffer; |
| 144 | # append original entry |
| 145 | unshift @matches, $entry if (scalar @matches); |
| 146 | return @matches; |
| 147 | } |
| 148 | |
| 149 | sub merge_edit_entries { |
| 150 | my (@entries) = @_; |
| 151 | my $tmp = `mktemp --suffix .merge.ledger`; |
| 152 | chomp $tmp; |
| 153 | open TMP, '>', $tmp |
| 154 | or die "Unable to open temp file for writing: $!"; |
| 155 | print_entry \*TMP, $_ for @entries; |
| 156 | close TMP; |
| 157 | system("$editor $tmp"); |
| 158 | open TMP, '<', $tmp |
| 159 | or die "Unable to open temp file for reading $!"; |
| 160 | print OUTFILE while (<TMP>); |
| 161 | close TMP; |
| 162 | system("rm $tmp"); |
| 163 | return 1; |
| 164 | } |
| 165 | |
| 166 | sub merge_entries { |
| 167 | my (@entries) = @_; |
| 168 | print STDERR "Found possible matching transactions:\n\n"; |
| 169 | print_entry \*STDERR, $_ for @entries; |
| 170 | my $entry_choices = join ' ', map { "[$_]" } (1 .. scalar @entries); |
| 171 | do { |
| 172 | print STDERR "Merge these entries? $entry_choices [n]o [e]dit\n> "; |
| 173 | my $input = <STDIN>; |
| 174 | return 0 unless defined $input; |
| 175 | chomp $input; |
| 176 | if ($input =~ /^[1-9][0-9]*$/) { |
| 177 | # Use one entry and discard the others |
| 178 | if (my $entry = $entries[$input-1]) { |
| 179 | print "Using entry $input.\n"; |
| 180 | print_entry \*OUTFILE, $entries[$input-1]; |
| 181 | return 1; |
| 182 | } |
| 183 | } elsif ($input =~ /^e(dit)?$/i) { |
| 184 | print "Editing entries.\n"; |
| 185 | merge_edit_entries(@entries) or die("Merge edit failed"); |
| 186 | return 1; |
| 187 | } elsif ($input =~ /^n?\s*$/i) { |
| 188 | print "Keeping entries separate.\n"; |
| 189 | return 0; |
| 190 | } |
| 191 | } until (0); |
| 192 | } |
| 193 | |
| 194 | sub replace_entry { |
| 195 | my $entry = shift; |
| 196 | return unless $entry; |
| 197 | |
| 198 | # remove this entry from the buffer |
| 199 | @buffer = grep { $_ != $entry } @buffer; |
| 200 | |
| 201 | # Read a new entry and add it to the buffer |
| 202 | my $fh = $entry->{fh}; |
| 203 | if (my $new_entry = read_entry $fh) { |
| 204 | push @buffer, $new_entry; |
| 205 | } |
| 206 | } |
| 207 | |
| 208 | # Open the ledger journals |
| 209 | for my $filename (@in_filenames) { |
| 210 | open my $fh, '<', $filename or die "Unable to open file $filename: $!"; |
| 211 | push @files, $fh; |
| 212 | } |
| 213 | |
| 214 | # Read initial buffer of entries from each journal |
| 215 | for my $fh (@files) { |
| 216 | for my $i (1 .. $buffer_size) { |
| 217 | my $entry = read_entry($fh); |
| 218 | last unless $entry; |
| 219 | push @buffer, $entry; |
| 220 | } |
| 221 | } |
| 222 | |
| 223 | # While the buffers contain entries, |
| 224 | # pop the oldest entry |
| 225 | while (my $entry = get_oldest_entry) { |
| 226 | # Look for entries matching this one |
| 227 | if (my @matching_entries = find_matching_entries $entry) { |
| 228 | # Present merge choices, |
| 229 | # and let the merged entry be printed |
| 230 | if (merge_entries(@matching_entries)) { |
| 231 | # user merged the entries |
| 232 | # Remove the merged entries from their buffers |
| 233 | replace_entry $_ for @matching_entries; |
| 234 | } else { |
| 235 | # user kept the entries seperate. |
| 236 | # Print the single entry and leave the others in their buffers |
| 237 | print_entry \*OUTFILE, $entry; |
| 238 | |
| 239 | # replace this entry in the buffer with a new one |
| 240 | replace_entry($entry); |
| 241 | } |
| 242 | } else { |
| 243 | # No matching entries. |
| 244 | # Print the entry and pick a new one |
| 245 | print_entry \*OUTFILE, $entry; |
| 246 | replace_entry($entry); |
| 247 | } |
| 248 | } |
| 249 |
Built with git-ssb-web