home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / export.pl < prev    next >
Perl Script  |  1998-10-07  |  5KB  |  171 lines
  1. #!/usr/bin/perl
  2. #  export.pl - functions to implement exporting data to other formats
  3. #
  4. #  Written by Curtis Olson.  Started October 19, 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: export.pl,v 2.7 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. # save data in the CBB format
  32. sub save_cbb {
  33.     # in: file base name
  34.     # out: result
  35.  
  36.     my($file) = @_;
  37.     my($key);
  38.  
  39.     if ($CBB::calced == 0) {
  40.     &calc_trans();
  41.     }
  42.  
  43.     open(SAVE, ">$file.new");
  44.  
  45.     if ($CBB::sorted_keys == 0) {
  46.     &sort_keys();
  47.     }
  48.  
  49.     foreach $key (@CBB::KEYS) {
  50.     print (SAVE "$CBB::TRANS{$key}\n");
  51.     }
  52.  
  53.     close(SAVE);
  54.  
  55.     unlink("$file.bak");
  56.     rename("$file", "$file.bak");
  57.     rename("$file.new", "$file");
  58.  
  59.     return "ok";
  60. }
  61.  
  62.  
  63. # Contributed by Christopher Browne, Oct. 18/94
  64. # export a quicken export file (.qif)
  65. sub export_qif {
  66.     # in: file
  67.     # out: result
  68.     
  69.     my($file) = @_;
  70.     my($key);
  71.     my($date, $check, $desc, $debit, $credit, $cat, $split, $com, $cleared);
  72.     my($amount, $i, @SPLIT, $scom, $scat, $junk);
  73.     my($dy, $mo, $yr);
  74.  
  75.     $CBB::sorted_keys = 0;
  76.     $CBB::calced = 0;
  77.     
  78.     open(QIF, ">$file");
  79.     
  80.     print QIF "Type:Bank\n";      # This will need to change,
  81.     # eventually, to handle other
  82.     # varieties of QUICKEN accounts.
  83.     # Credit cards, investments, etc.
  84.     # Later.
  85.  
  86.     ($date, $check, $desc, $debit, $credit, $cat, $split, $com,
  87.      $cleared) = ("", "", "", "", "", "", "", "", "");
  88.  
  89.     foreach $key (keys (%CBB::TRANS)) {
  90.         ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared,
  91.      $junk) = split(/\t/, $CBB::TRANS{$key});
  92.      
  93.     # Handle date
  94.     $yr = substr($date, 2, 2);
  95.     $mo = substr($date, 4, 2);
  96.     $dy = substr($date, 6, 2);
  97.     printf QIF "D%d/%2d/%2d\n", $mo, $dy, $yr;
  98.      
  99.     # Handle amount
  100.     $amount = $credit-$debit;
  101.     printf QIF "T%.2lf\n", $amount;
  102.  
  103.     printf QIF "C$cleared\n" unless ($cleared eq "");
  104.      
  105.     # Handle Ref. #
  106.     print QIF "N$check\n" unless ($check eq "");
  107.     print QIF "P$desc\n" unless ($desc eq "");
  108.  
  109.     # Replace underscores by blanks in transfer categories. (BW)  
  110.     while (($cat =~ s/\[([^\]_]*)_([^\]]*)\]/\[$1 $2\]/g) != 0) {
  111.     }
  112.  
  113.     print QIF "L$cat\n" unless (substr($cat, 0, 1) eq "\|");  # split txn
  114.     # Handle splitting of txn
  115.     if (substr($cat, 0, 1) eq "\|")    {
  116.         # Take: |Salary|2434.70|Tax-Fed|-0.34|Tax-FICA|-33.25|Tax-State|-5.78|
  117.         @SPLIT = split(/\|/, $cat);
  118.         print QIF "L$SPLIT[1]\n";   
  119.         # Pretend that the initial category is "the one"
  120.         for ($i = 1 ; $i <= $#SPLIT ; $i += 3) {
  121.         $scat = $SPLIT[$i];
  122.         print QIF "S$scat\n";
  123.         $scom = $SPLIT[$i+1];
  124.         print QIF "E$scom\n";
  125.         $amount = $SPLIT[$i+2];
  126.         print QIF "\$$amount\n";
  127.         }
  128.     } else {
  129.     }
  130.     print QIF "M$com\n" unless ($com eq "");
  131.     print QIF  "^\n";
  132.     }
  133.     
  134.     close(QIF);
  135.  
  136.     return "ok";
  137. }
  138.  
  139.  
  140. 1;                # need to return a true value
  141.  
  142.  
  143. # ----------------------------------------------------------------------------
  144. # $Log: export.pl,v $
  145. # Revision 2.7  1997/04/23 18:07:28  curt
  146. # Patched these to make importing/exporting more seamless.
  147. #
  148. # Revision 2.6  1997/01/18 03:28:43  curt
  149. # Added "use strict" pragma to enforce good scoping habits.
  150. #
  151. # Revision 2.5  1996/12/17 14:53:55  curt
  152. # Updated copyright date.
  153. #
  154. # Revision 2.4  1996/12/16 04:18:16  curt
  155. # Continuing the great overhaul of December 1996.
  156. #
  157. # Revision 2.3  1996/12/11 18:33:34  curt
  158. # Ran a spell checker.
  159. #
  160. # Revision 2.2  1996/07/13 02:57:42  curt
  161. # Version 0.65
  162. # Packing Changes
  163. # Documentation changes
  164. # Changes to handle a value in both debit and credit fields.
  165. #
  166. # Revision 2.1  1996/02/27  05:35:41  curt
  167. # Just stumbling around a bit with cvs ... :-(
  168. #
  169. # Revision 2.0  1996/02/27  04:42:54  curt
  170. # Initial 2.0 revision.  (See "Log" files for old history.)
  171.