Annotation of pta/pta_import.pl, Revision 1.33
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.31 freda 51: $delim, $header, $quantity_field, $quote, $subaccount,
52: @amount_fields, @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";
1.31 freda 124: s/^(.*)$delim\s+(\d+)\s+(\S+)\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,
1.31 freda 130: su => $4,
1.12 schwarze 131: };
1.1 schwarze 132: }
1.9 schwarze 133: close $in;
134: $csv_account or die "no ACCOUNT line in $fn";
1.13 schwarze 135:
136: # Parse the CSV file from the bank.
1.21 schwarze 137: if (@ARGV) {
138: open STDIN, '<', $ARGV[0] or die "$ARGV[0]: $!";
139: }
140: LINE: while (<STDIN>) {
1.13 schwarze 141: chomp;
1.28 freda 142: s/\s*$//;
1.13 schwarze 143: next if (/^$/);
1.20 freda 144: foreach my $ignore (@ignored) {
145: next LINE if /$ignore/;
146: }
1.13 schwarze 147: my $line = $_;
1.14 schwarze 148: if ($header) {
149: $line eq $header
150: or die "expected HEADER $header\nbut got $line";
151: undef $header;
152: next;
153: }
1.18 freda 154: my $copy_line = $line;
155: my @fields;
1.32 freda 156: while ($copy_line =~ /./) {
157: $quote && $copy_line =~ s/^$quote(.*?)$quote(?:$delim|$)//
158: or $copy_line =~ s/^(.*?)(?:$delim|$)//;
159: push @fields, $1;
1.18 freda 160: }
1.13 schwarze 161: my $matches = 0;
162: my ($account, $booking);
163: foreach my $selector (@compiled) {
164: $matches = 1;
165: for (my $i = 0; $i <= $#{$selector->{re}}; $i++) {
166: next if $fields[$i] =~ $selector->{re}[$i];
167: $matches = 0;
168: last;
169: }
170: if ($matches) {
171: $account = $selector->{ac};
172: $booking = $selector->{id};
1.31 freda 173: $subaccount = $selector->{su};
1.13 schwarze 174: last;
175: }
176: }
177: $matches or die "unmatched CSV line: $line";
1.33 ! freda 178: my $date = $fields[$date_field];
! 179: defined $date or die "undefined date: $line";
! 180: $date or die "date ($date) parse error: $line";
1.27 schwarze 181: eval '$date =~ ' . $date_regex;
1.25 freda 182: foreach my $i (@amount_fields) {
183: if (defined($fields[$i])) {
184: $fields[$i] =~ s/,/./;
185: $fields[$i] =~ s/\$//;
186: $fields[$i] = "-$1" if $fields[$i] =~ /^\((\d+\.\d+)\)/;
187: }
188: }
1.26 schwarze 189: my $debit = $csv_account;
190: my $credit = $account;
191: my $amount = $fields[$amount_fields[-1]] || -$fields[$amount_fields[0]];
192: if ($amount < 0) {
193: $amount *= -1;
194: $credit = $csv_account;
195: $debit = $account;
196: }
197: $amount = sprintf "%.2f", $amount;
1.25 freda 198: my $description = join ' ', @fields[@description_fields];
1.30 freda 199: defined($date) && defined($amount) && defined($debit) &&
200: defined($credit) && defined($description)
1.13 schwarze 201: or die "import parse error: $line";
202: $description =~ s/#//g;
1.25 freda 203: $description .= " [$fields[$cost_center_field]]"
204: if $cost_center_field;
205: $description .= " quantity $fields[$quantity_field]"
206: if $quantity_field;
1.31 freda 207: $description .= " ($subaccount)"
208: if $subaccount;
209:
1.13 schwarze 210: print "$date $booking $debit $credit $amount $description\n";
211: }
CVSweb
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to pta_import.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [cvsweb.bsd.lv] / pta