Annotation of pta/pta_import.pl, Revision 1.29
1.17 schwarze 1: #!/usr/bin/perl
1.1 schwarze 2:
3: # Copyright (c) 2020 Freda Bundchen
4:
5: # Permission to use, copy, modify, and distribute this software for any
6: # purpose with or without fee is hereby granted, provided that the above
7: # copyright notice and this permission notice appear in all copies.
8: #
9: # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10: # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11: # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12: # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13: # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14: # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15: # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16:
17: use warnings;
18: use strict;
19:
1.9 schwarze 20: use Getopt::Std qw(getopts);
21:
22: our ($opt_I);
23:
1.27 schwarze 24: my %date_formats = (
25: 'MM/DD/YYYY' => 's#(\d+)/(\d+)/(\d+)#$3$1$2#',
26: 'MM/DD/YY' => 's#(\d+)/(\d+)/(\d+)#20$3$1$2#',
27: 'YYYY-MM-DD' => 's#(\d+)-(\d+)-(\d+)#$1$2$3#',
28: 'DD.MM.YY' => 's#(\d+)\.(\d+)\.(\d+)#20$3$2$1#',
29: );
30:
1.1 schwarze 31: # === SUBROUTINES =====================================================
1.9 schwarze 32:
33: sub usage () {
1.10 schwarze 34: printf STDERR "usage: %s -I accountname csvfilename\n", $0;
1.9 schwarze 35: exit 1;
36: }
37:
1.1 schwarze 38: # === MAIN PROGRAM =====================================================
39:
1.9 schwarze 40: getopts 'I:' or usage;
1.14 schwarze 41: unless ($opt_I) {
42: warn "The option -I is required.";
1.9 schwarze 43: usage;
44: }
1.14 schwarze 45: my $account_name = $opt_I;
1.13 schwarze 46:
47: # Parse the configuration file.
1.23 freda 48: my $fn = "import/" . $account_name . ".txt";
1.14 schwarze 49: open my $in, '<', $fn or die "$fn: $!";
1.27 schwarze 50: my ($cost_center_field, $csv_account, $date_field, $date_regex,
1.25 freda 51: $delim, $header, $quantity_field, $quote, @amount_fields,
52: @compiled, @description_fields, @ignored);
1.9 schwarze 53: while (<$in>) {
54: chomp;
1.28 freda 55: s/\s+$//;
1.9 schwarze 56: next if /^(?:#|$)/;
57: my $line = $_;
1.28 freda 58: if (s/^ACCOUNT\s+//) {
59: $csv_account and die "duplicate ACCOUNT line: $_";
60: /^(\d+)$/ or die "ACCOUNT parse error: $_";
1.9 schwarze 61: $csv_account = $1;
62: next;
63: }
1.25 freda 64: if (s/^AMOUNT\s+//) {
1.28 freda 65: @amount_fields and die "duplicate AMOUNT line: $_";
1.25 freda 66: push @amount_fields, $1 - 1 while s/(\d+)\s*//;
67: $_ eq '' or die "trailing garbage: AMOUNT ... $_";
68: next;
69: }
1.28 freda 70: if (s/^COSTCENTER\s+//) {
71: $cost_center_field and
72: die "duplicate COSTCENTER line: $_";
73: /^(\d+)$/ or die "COSTCENTER parse error: $_";
1.25 freda 74: $cost_center_field = $1 - 1;
75: next;
76: }
1.28 freda 77: if (s/^DATE\s+//) {
78: $date_field || $date_regex and
79: die "duplicate DATE line: $_";
80: s/^(\d+)\s+(\S+)$//;
81: $date_field = $1 or
82: die "DATE date_field parse error: $_";
83: $date_field -= 1;
1.27 schwarze 84: $date_regex = $date_formats{$2}
85: or die "unknown date format: $2";
1.25 freda 86: next;
87: }
1.28 freda 88: if (s/^DELIM\s+//) {
1.12 schwarze 89: $delim and die "duplicate DELIM line: $1";
1.28 freda 90: /^([^|\^\$\*\+\?\(\)\[\]\{\}\\])$/ or
91: die "DELIM parse error: $_";
1.12 schwarze 92: $delim = $1;
93: next;
94: }
1.25 freda 95: if (s/^DESCRIPTION\s+//) {
1.28 freda 96: @description_fields and die "duplicate DESCRIPTION line: $_";
97: push @description_fields, $1 - 1 while s/(\d+)\s*//;
98: $_ eq '' or die "trailing garbage: DESCRIPTION ... $_";
99: next;
1.25 freda 100: }
1.28 freda 101: if (s/^HEADER\s+//) {
1.14 schwarze 102: $header and die "duplicate HEADER line: $1";
1.28 freda 103: $header = $_;
1.14 schwarze 104: next;
105: }
1.28 freda 106: if (s/^IGNORE\s+//) {
107: push @ignored, qr/$_/;
1.25 freda 108: next;
109: }
1.28 freda 110: if (s/^QUANTITY\s+//) {
111: $quantity_field and die "duplicate QUANTITY line: $1";
112: /^(\d+)$/ or die "QUANTITY parse error: $_";
1.25 freda 113: $quantity_field = $1 - 1;
114: next;
115: }
1.28 freda 116: if (s/^QUOTE\s+//) {
1.18 freda 117: $quote and die "duplicate QUOTE line: $1";
1.28 freda 118: /^([^|\^\$\*\+\?\(\)\[\]\{\}\\])$/ or
119: die "QUOTE parse error: $_";
1.18 freda 120: $quote = $1;
121: next;
122: }
1.12 schwarze 123: $delim or die "no DELIM line in $fn";
124: s/^(.*)$delim\s+(\d+)\s+(\S+)// or
1.9 schwarze 125: die "$fn import parse error: $line";
1.12 schwarze 126: push @compiled, {
127: re => [map { qr/$_/ } split /$delim/, $1],
128: ac => $2,
129: id => $3,
130: };
1.1 schwarze 131: }
1.9 schwarze 132: close $in;
133: $csv_account or die "no ACCOUNT line in $fn";
1.13 schwarze 134:
135: # Parse the CSV file from the bank.
1.21 schwarze 136: if (@ARGV) {
137: open STDIN, '<', $ARGV[0] or die "$ARGV[0]: $!";
138: }
139: LINE: while (<STDIN>) {
1.13 schwarze 140: chomp;
1.28 freda 141: s/\s*$//;
1.13 schwarze 142: next if (/^$/);
1.20 freda 143: foreach my $ignore (@ignored) {
144: next LINE if /$ignore/;
145: }
1.13 schwarze 146: my $line = $_;
1.14 schwarze 147: if ($header) {
148: $line eq $header
149: or die "expected HEADER $header\nbut got $line";
150: undef $header;
151: next;
152: }
1.18 freda 153: my $copy_line = $line;
154: my @fields;
155: if ($quote) {
156: push @fields, $1 while $copy_line =~ s/$quote([^$quote]*)$quote$delim?//;
157: } else {
158: @fields = split /$delim/, $line;
159: }
1.13 schwarze 160: my $matches = 0;
161: my ($account, $booking);
162: foreach my $selector (@compiled) {
163: $matches = 1;
164: for (my $i = 0; $i <= $#{$selector->{re}}; $i++) {
165: next if $fields[$i] =~ $selector->{re}[$i];
166: $matches = 0;
167: last;
168: }
169: if ($matches) {
170: $account = $selector->{ac};
171: $booking = $selector->{id};
172: last;
173: }
174: }
175: $matches or die "unmatched CSV line: $line";
1.25 freda 176: my $date = $fields[$date_field] or
177: die "date parse error: $line";
1.27 schwarze 178: eval '$date =~ ' . $date_regex;
1.25 freda 179: foreach my $i (@amount_fields) {
180: if (defined($fields[$i])) {
181: $fields[$i] =~ s/,/./;
182: $fields[$i] =~ s/\$//;
183: $fields[$i] = "-$1" if $fields[$i] =~ /^\((\d+\.\d+)\)/;
184: }
185: }
1.26 schwarze 186: my $debit = $csv_account;
187: my $credit = $account;
188: my $amount = $fields[$amount_fields[-1]] || -$fields[$amount_fields[0]];
189: if ($amount < 0) {
190: $amount *= -1;
191: $credit = $csv_account;
192: $debit = $account;
193: }
194: $amount = sprintf "%.2f", $amount;
1.25 freda 195: my $description = join ' ', @fields[@description_fields];
1.13 schwarze 196: $date && $amount && $debit && $credit && $description
197: or die "import parse error: $line";
198: $description =~ s/#//g;
1.25 freda 199: $description .= " [$fields[$cost_center_field]]"
200: if $cost_center_field;
201: $description .= " quantity $fields[$quantity_field]"
202: if $quantity_field;
1.13 schwarze 203: print "$date $booking $debit $credit $amount $description\n";
204: }
CVSweb