home *** CD-ROM | disk | FTP | other *** search
/ Chip: Linux Special / CorelLinux_CHIP.iso / live / usr / X11R6 / lib / X11 / cbb / common.pl < prev    next >
Encoding:
Perl Script  |  1998-10-07  |  7.3 KB  |  264 lines
  1. #!/usr/bin/perl
  2. #  common.pl - common routines shared by many files
  3. #
  4. #  Written by Curtis Olson.  Started August 22, 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: common.pl,v 2.11 1997/05/06 01:00:26 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. # We need a version number
  32. $CBB::version = "Version 0.74";
  33. ($CBB::junk, $CBB::version_num, $CBB::junk) = split(/ +/, $CBB::version);
  34.  
  35.  
  36. # Contributed by Christopher Browne, Oct. 24/94
  37. sub pad { 
  38.     return sprintf("%02d", $_[0]); 
  39. }
  40.  
  41.  
  42. # return the directory of a file name 
  43. sub file_dirname {
  44.     my($file) = @_;
  45.     my($pos);
  46.  
  47.     $pos = rindex($file, "/");
  48.     if ( $pos >= 0 ) {
  49.     return substr($file, 0, ($pos + 1));
  50.     } else {
  51.     return "./";
  52.     }
  53. }
  54.  
  55.  
  56. # return the base file name
  57. sub file_basename {
  58.     my($file) = @_;
  59.     my($pos);
  60.  
  61.     $pos = rindex($file, "/");
  62.     return substr($file, ($pos + 1));
  63. }
  64.  
  65.  
  66. # return the file name root (ending at last ".")
  67. sub file_root {
  68.     my($file) = @_;
  69.     my($pos);
  70.  
  71.     $pos = rindex($file, ".");
  72.     return substr($file, 0, $pos);
  73. }
  74.  
  75.  
  76. # return the file name extension (starting at first ".")
  77. sub file_extension {
  78.     my($file) = @_;
  79.     my($pos);
  80.  
  81.     $pos = rindex($file, ".");
  82.     return substr($file, ($pos + 1));
  83. }
  84.  
  85.  
  86. # return current date in a nice format
  87. sub nice_date {
  88.     my($date_fmt) = @_;
  89.  
  90.     my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
  91.         localtime(time);
  92.  
  93.     if ( $date_fmt == 1 ) {
  94.         return &pad($mon+1) . "/" . &pad($mday) . "/" . &pad($year);
  95.     } else {
  96.         return &pad($mday) . "." . &pad($mon+1) . "." . &pad($year);
  97.     }
  98. }
  99.  
  100.  
  101. # return current date in a raw format
  102. sub raw_date {
  103.     my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
  104.         localtime(time);
  105.     return ¢ury() . &pad($year) . &pad($mon+1) . &pad($mday);
  106. }
  107.  
  108. # start date: return date in raw format, takes argument of those types:
  109. # -[num]m months (eg. "-0m" means only current month, "-1m" means current and last)
  110. # -[num]d days (eg. "-10m" means 10 days)
  111. # dd.mm.yy[yy] : "international" format
  112. # mm/dd/yy[yy] : "us" format
  113. # yyyymmdd     : "raw" format
  114. #
  115. # This can get a bit complicated, thank god we don't have to care whether
  116. # we return invalid days
  117.  
  118. sub start_date {
  119.     my($idate) = @_;
  120.     my($odate, $value);
  121.     my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
  122.         localtime(time);
  123.  
  124.     $mon = $mon + 1;
  125.  
  126.     if ( $idate =~ /^\d{8}$/ ) {     # "raw" format
  127.     $odate = $idate;
  128.     } elsif ($idate =~ /^-\d{1,2}m$/ ) {    # "month" format
  129.  
  130.     $value = substr($idate, 1, 3);    # a maximum of 99 months !
  131.     if ($value >= $mon) {
  132.         $year = $year - 1 - int( ($value - $mon) / 12 );
  133.         $value = ($value % 12 );
  134.     }
  135.     $mon = $mon - $value;
  136.     if ($mon < 1) {
  137.         $value = $value + 12; 
  138.     }
  139.     $odate = ¢ury() . &pad($year) . &pad($mon) . &pad(1);
  140.  
  141.     } elsif ($idate =~ /^-\d{1,3}d$/ ) {    # "day" format
  142.  
  143.     $value = substr($idate, 1, 4);    # a maximum of 999 days !
  144.     if ($value >= $yday) {
  145.         $year = $year - 1 - int( ($value - $yday) / 360 );
  146.         $value = ( $value % 360 );
  147.     }
  148.     if ($value >= $mday) {
  149.         $mon = $mon - 1 - int( ($value - $mday) / 30 );
  150.         if ($mon < 1) {
  151.             $mon = $mon + 12;
  152.         }
  153.         $value = ( $value % 30 );
  154.     }
  155.     $mday = $mday - $value;
  156.     if ($mday < 1) {
  157.         $mday = $mday + 30;
  158.     }
  159.     $odate = ¢ury() . &pad($year) . &pad($mon) . &pad($mday);
  160.  
  161.     } elsif ( $idate =~ /^\d{1,2}\/\d{1,2}\/\d{2,4}$/ ) {     # "us" format
  162.  
  163.     ($mon, $mday, $year) = split(/\//, $idate);
  164.     if ($year < 100) {
  165.         $value = ¢ury();
  166.     } else {
  167.         $value = $year / 100;
  168.     }
  169.     $odate = &pad($value) . &pad($year) . &pad($mon) . &pad($mday);
  170.  
  171.     } elsif ( $idate =~ /^\d{1,2}\.\d{1,2}\.\d{2,4}$/ ) {     # "int" format
  172.  
  173.     ($mday, $mon, $year) = split(/\./, $idate);
  174.     if ($year < 100) {
  175.         $value = ¢ury();
  176.     } else {
  177.         $value = $year / 100;
  178.     }
  179.     $odate = &pad($value) . &pad($year) . &pad($mon) . &pad($mday);
  180.  
  181.     } else {    # nonsense, give them everything since 1900
  182.     $odate = "19000101";
  183.     }
  184.  
  185.     return ($odate);
  186. }
  187.  
  188. # return the current century in the form 19, 20, 21, etc.
  189. # requires the Unix "date" command to be in the path
  190. sub century {
  191.     my($unix_date, $year, $century, $junk);
  192.  
  193.     $unix_date = localtime;  # e.g. "Thu Oct  3 16:53:37 1996"
  194.     ($junk, $junk, $junk, $junk, $year) = split(/\s+/, $unix_date);
  195.     $century = substr($year, 0, 2);
  196.  
  197.     return($century);
  198. }
  199.  
  200.  
  201. 1;                # need to return a true value
  202.  
  203.  
  204. # ----------------------------------------------------------------------------
  205. # $Log: common.pl,v $
  206. # Revision 2.11  1997/05/06 01:00:26  curt
  207. # Added patches contributed by Martin Schenk <schenkm@ping.at>
  208. # - Default to umask of 066 so .CBB files get created rw by owner only
  209. # - Added support for pgp encrypting data files
  210. # - Added support for displaying only recent parts of files (avoids
  211. #   waiting to load in lots of old txns you don't currently need.)
  212. # - Added a feature to "cache" whole accounts in the perl engine so
  213. #   that switching between accounts can be faster.
  214. # - The above options can be turned on/off via the preferrences menu.
  215. #
  216. # Revision 2.10  1997/01/18 03:28:41  curt
  217. # Added "use strict" pragma to enforce good scoping habits.
  218. #
  219. # Revision 2.9  1996/12/17 14:53:54  curt
  220. # Updated copyright date.
  221. #
  222. # Revision 2.8  1996/12/11 18:33:30  curt
  223. # Ran a spell checker.
  224. #
  225. # Revision 2.7  1996/10/03 22:02:25  curt
  226. # I found a way in perl to get the century directly, so I was able to
  227. # eliminate the dependency on the external Unix date command.
  228. #
  229. # Revision 2.6  1996/10/03 04:48:59  curt
  230. # Fixed an inconsistency in &raw_date() in common.pl (with how it was
  231. # called.)
  232. #
  233. # Version now is 0.67-beta-x
  234. #
  235. # Revision 2.5  1996/10/03 04:13:39  curt
  236. # Refined default century handling code.
  237. #
  238. # Revision 2.4  1996/10/03 03:52:57  curt
  239. # CBB now determines the current century automatically ... no need for it
  240. # to be hard coded.  Removed all hardcoded instances of the century (especially
  241. # in reports.pl and recur.pl)
  242. #
  243. # Added an optional --debug flag to the invocation of CBB.
  244. #
  245. # Revision 2.3  1996/10/02 19:37:18  curt
  246. # Replaced instances of hardcoded century (19) with a variable.  We need to
  247. # know the current century in cases where it is not provided and it is
  248. # assumed to be the current century.  Someday I need to figure out how
  249. # to determine the current century, but I have a couple of years to do it. :-)
  250. #
  251. # I still need to fix conf-reports and reports.pl
  252. #
  253. # Revision 2.2  1996/07/13 02:57:39  curt
  254. # Version 0.65
  255. # Packing Changes
  256. # Documentation changes
  257. # Changes to handle a value in both debit and credit fields.
  258. #
  259. # Revision 2.1  1996/02/27  05:35:37  curt
  260. # Just stumbling around a bit with cvs ... :-(
  261. #
  262. # Revision 2.0  1996/02/27  04:41:50  curt
  263. # Initial 2.0 revision.  (See "Log" files for old history.)
  264.