home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / import.pl < prev    next >
Perl Script  |  1998-10-07  |  6KB  |  225 lines
  1. #!/usr/bin/perl
  2. #  import.pl - functions to implement importing from other formats
  3. #
  4. #  Written by Curtis Olson.  Started August 25, 1994.
  5. #
  6. #  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
  7. #
  8. #  This program is free software; you can redistribute it and/or modify
  9. #  it under the terms of the GNU General Public License as published by
  10. #  the Free Software Foundation; either version 2 of the License, or
  11. #  (at your option) any later version.
  12. #
  13. #  This program is distributed in the hope that it will be useful,
  14. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. #  GNU General Public License for more details.
  17. #
  18. #  You should have received a copy of the GNU General Public License
  19. #  along with this program; if not, write to the Free Software
  20. #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. # $Id: import.pl,v 2.5 1997/04/23 18:07:28 curt Exp $
  23. # (Log is kept at end of this file)
  24.  
  25.  
  26. package CBB;
  27.  
  28. use strict;   # don't take no guff
  29.  
  30.  
  31. # @INC specifies the installed location of the necessary pieces.
  32. # It should already be setup by wrapper.pl
  33.  
  34. require "common.pl";
  35.  
  36.  
  37. # load data from a CBB format file
  38. sub load_cbb {
  39.     # in: file base name
  40.     # out: result
  41.  
  42.     my($file) = @_;
  43.     $CBB::sorted_keys = 0;
  44.     $CBB::calced = 0;
  45.  
  46.     open(LOAD, "<$file") || return "error";
  47.  
  48.     while ( <LOAD> ) {
  49.     if ( m/^\s*#/ ) {
  50.         # toss the comment (any line whose 1st non-whitespace character is
  51.         #                   the pound sign.)
  52.     } else {
  53.         chop;
  54.         &create_trans($_);
  55.     }
  56.     }
  57.  
  58.     close(LOAD);
  59.  
  60.     return "ok";
  61. }
  62.  
  63.  
  64. # import a quicken export file (.qif)
  65. sub import_qif {
  66.     # in: file
  67.     # out: result
  68.  
  69.     my($file) = @_;
  70.     my($date, $check, $desc, $debit, $credit, $cat, $split, $com, $cleared);
  71.     my($amt, $found_split_com);
  72.     my($day, $month, $year);
  73.     my($iend, $incat, $splitsub, $insplit);
  74.  
  75.     $CBB::sorted_keys = 0;
  76.     $CBB::calced = 0;
  77.  
  78.     open(QIF, "<$file");
  79.  
  80.     ($date, $check, $desc, $debit, $credit, $cat, $split, $com, 
  81.         $cleared) = ("", "", "", "", "", "", "", "", "");
  82.  
  83.     while ( <QIF> ) {
  84.     chop;            # get rid of that pesky newline.
  85.     # s/:/-/g;        # eliminate our delimiter characters from
  86.     s/\|/-/g;        # the import file.
  87.     s/\r//g;        # strip the dos ^M if needed
  88.     if ( m/^\!/ ) {
  89.         # Type
  90.         # print "$_\n";
  91.     } elsif ( m/^D/ ) {
  92.         # Date
  93.         ($month, $day, $year) = split(/\/ */, substr($_,1));
  94.         $month = &pad($month);
  95.         $day = &pad($day);
  96.         $date = "$year$month$day";
  97.         # print "$date\n";
  98.     } elsif ( m/^T/ ) {
  99.         # Transaction Amount
  100.         s/,//g;        # remove , from numbers (i.e. thousands)
  101.         $amt = substr($_,1);
  102.         if ($amt >= 0) {
  103.         $credit = $amt;
  104.         $debit = 0;
  105.         } else {
  106.         $debit = substr($amt,1); # remove the '-' to make amt >= 0
  107.         $credit = 0;
  108.         }
  109.         # print "credit = $credit  debit = $debit\n";
  110.     } elsif ( m/^C/ ) {
  111.         # Cleared
  112.         $cleared = substr($_,1);
  113.         # print "Cleared = $cleared\n";
  114.     } elsif ( m/^N/ ) {
  115.         # check Number
  116.         $check = substr($_,1);
  117.         # print "Check # = $check\n";
  118.     } elsif ( m/^P/ ) {
  119.         # descriPtion
  120.         $desc = substr($_,1);
  121.         # print "$desc\n";
  122.     } elsif ( m/^L/ ) {
  123.         # category
  124.         #
  125.         # Check for and replace whitespace in account transfer 
  126.         # categories with underscores. (Cbb equates account "acct"
  127.         # with account file name "acct.cbb".) B.W.
  128.         #
  129.         $cat = substr($_,1);
  130.         if ( substr($cat,0,1) eq "[" ) {
  131.         $iend = index($cat,"]");
  132.         if ($iend != -1) {
  133.             $incat = substr($cat,1,$iend - 1);
  134.             $incat =~ s/\s/_/g;
  135.             $cat = "[".$incat."]";
  136.         }
  137.         }
  138.         #print "Category = $cat\n";
  139.     } elsif ( m/^S/ ) {
  140.         # split category
  141.         #
  142.         # Check for and replace whitespace in account transfer 
  143.         # categories with underscores. (Cbb equates account "acct"
  144.         # with account file name "acct.cbb".) B.W.
  145.         #
  146.         $splitsub = substr($_,1);
  147.         if ( substr($splitsub,0,1) eq "[" ) {
  148.         $iend = index($splitsub,"]");
  149.         if ($iend != -1) {
  150.             $insplit = substr($splitsub,1,$iend - 1);
  151.             $insplit =~ s/\s/_/g;
  152.             $splitsub = "[".$insplit."]";
  153.         }
  154.         }
  155.         if ($split eq "") {
  156.         # first split
  157.         $split = "|".$splitsub."|";
  158.         } else {
  159.         # not first split :)
  160.         $split = $split.$splitsub."|";
  161.         }
  162.         #print "Split category = $split\n";
  163.     } elsif ( m/^E/ ) {
  164.         # split comment
  165.         $split = $split.substr($_,1)."|";
  166.         $found_split_com = 1;
  167.     } elsif ( m/^\$/ ) {
  168.         # split amount
  169.         if ( ! $found_split_com ) {
  170.         $split = $split . "|";
  171.         $found_split_com = 0;
  172.         }
  173.         $split = $split.substr($_,1)."|";
  174.     } elsif ( m/^M/ ) {
  175.         # coMment
  176.         $com = substr($_,1);
  177.         #print "Comment = $com\n";
  178.     } elsif ( m/^\^/ ) {
  179.         #print "End of record\n";
  180.         if ($split ne "") {
  181.         $cat = $split;
  182.         }
  183.         &create_trans(
  184.             "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t0.00" );
  185.         ($date, $check, $desc, $debit, $credit, $cat, $split, $com, 
  186.             $cleared) = ("", "", "", "", "", "", "", "", "");
  187.     } elsif ( $_ eq "" ) {
  188.         # toss empty lines ...
  189.     } else {
  190.         print "unknown data: $_\n";
  191.     }
  192.     }
  193.  
  194.     close(QIF);
  195.  
  196.     return "ok";
  197. }
  198.  
  199.  
  200. 1;                # need to return a true value
  201.  
  202.  
  203. # ----------------------------------------------------------------------------
  204. # $Log: import.pl,v $
  205. # Revision 2.5  1997/04/23 18:07:28  curt
  206. # Patched these to make importing/exporting more seamless.
  207. #
  208. # Revision 2.4  1997/01/18 03:28:44  curt
  209. # Added "use strict" pragma to enforce good scoping habits.
  210. #
  211. # Revision 2.3  1996/12/17 14:53:58  curt
  212. # Updated copyright date.
  213. #
  214. # Revision 2.2  1996/07/13 02:57:46  curt
  215. # Version 0.65
  216. # Packing Changes
  217. # Documenation changes
  218. # Changes to handle a value in both debit and credit fields.
  219. #
  220. # Revision 2.1  1996/02/27  05:35:44  curt
  221. # Just stumbling around a bit with cvs ... :-(
  222. #
  223. # Revision 2.0  1996/02/27  04:42:58  curt
  224. # Initial 2.0 revision.  (See "Log" files for old history.)
  225.