#!/usr/local/bin/perl
#  common.pl - common routines shared by many files
#
#  Written by Curtis Olson.  Started August 22, 1994.
#
#  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

# $Id: common.pl,v 2.11 1997/05/06 01:00:26 curt Exp $
# (Log is kept at end of this file)


package CBB;

use strict;    # don't take no guff


# We need a version number
$CBB::version = "Version <not_installed>";
($CBB::junk, $CBB::version_num, $CBB::junk) = split(/ +/, $CBB::version);


# Contributed by Christopher Browne, Oct. 24/94
sub pad { 
    return sprintf("%02d", $_[0]); 
}


# return the directory of a file name 
sub file_dirname {
    my($file) = @_;
    my($pos);

    $pos = rindex($file, "/");
    if ( $pos >= 0 ) {
	return substr($file, 0, ($pos + 1));
    } else {
	return "./";
    }
}


# return the base file name
sub file_basename {
    my($file) = @_;
    my($pos);

    $pos = rindex($file, "/");
    return substr($file, ($pos + 1));
}


# return the file name root (ending at last ".")
sub file_root {
    my($file) = @_;
    my($pos);

    $pos = rindex($file, ".");
    return substr($file, 0, $pos);
}


# return the file name extension (starting at first ".")
sub file_extension {
    my($file) = @_;
    my($pos);

    $pos = rindex($file, ".");
    return substr($file, ($pos + 1));
}


# return current date in a nice format
sub nice_date {
    my($date_fmt) = @_;

    my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
        localtime(time);

    if ( $date_fmt == 1 ) {
        return &pad($mon+1) . "/" . &pad($mday) . "/" . &pad($year);
    } else {
        return &pad($mday) . "." . &pad($mon+1) . "." . &pad($year);
    }
}


# return current date in a raw format
sub raw_date {
    my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
        localtime(time);
    return &century() . &pad($year) . &pad($mon+1) . &pad($mday);
}

# start date: return date in raw format, takes argument of those types:
# -[num]m months (eg. "-0m" means only current month, "-1m" means current and last)
# -[num]d days (eg. "-10m" means 10 days)
# dd.mm.yy[yy] : "international" format
# mm/dd/yy[yy] : "us" format
# yyyymmdd     : "raw" format
#
# This can get a bit complicated, thank god we don't have to care whether
# we return invalid days

sub start_date {
    my($idate) = @_;
    my($odate, $value);
    my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
        localtime(time);

    $mon = $mon + 1;

    if ( $idate =~ /^\d{8}$/ ) {	 # "raw" format
	$odate = $idate;
    } elsif ($idate =~ /^-\d{1,2}m$/ ) {	# "month" format

	$value = substr($idate, 1, 3);	# a maximum of 99 months !
	if ($value >= $mon) {
		$year = $year - 1 - int( ($value - $mon) / 12 );
		$value = ($value % 12 );
	}
	$mon = $mon - $value;
	if ($mon < 1) {
		$value = $value + 12; 
	}
	$odate = &century() . &pad($year) . &pad($mon) . &pad(1);

    } elsif ($idate =~ /^-\d{1,3}d$/ ) {	# "day" format

	$value = substr($idate, 1, 4);	# a maximum of 999 days !
	if ($value >= $yday) {
		$year = $year - 1 - int( ($value - $yday) / 360 );
		$value = ( $value % 360 );
	}
	if ($value >= $mday) {
		$mon = $mon - 1 - int( ($value - $mday) / 30 );
		if ($mon < 1) {
			$mon = $mon + 12;
		}
		$value = ( $value % 30 );
	}
	$mday = $mday - $value;
	if ($mday < 1) {
		$mday = $mday + 30;
	}
	$odate = &century() . &pad($year) . &pad($mon) . &pad($mday);

    } elsif ( $idate =~ /^\d{1,2}\/\d{1,2}\/\d{2,4}$/ ) { 	# "us" format

	($mon, $mday, $year) = split(/\//, $idate);
	if ($year < 100) {
		$value = &century();
	} else {
		$value = $year / 100;
	}
	$odate = &pad($value) . &pad($year) . &pad($mon) . &pad($mday);

    } elsif ( $idate =~ /^\d{1,2}\.\d{1,2}\.\d{2,4}$/ ) { 	# "int" format

	($mday, $mon, $year) = split(/\./, $idate);
	if ($year < 100) {
		$value = &century();
	} else {
		$value = $year / 100;
	}
	$odate = &pad($value) . &pad($year) . &pad($mon) . &pad($mday);

    } else {	# nonsense, give them everything since 1900
	$odate = "19000101";
    }

    return ($odate);
}

# return the current century in the form 19, 20, 21, etc.
# requires the Unix "date" command to be in the path
sub century {
    my($unix_date, $year, $century, $junk);

    $unix_date = localtime;  # e.g. "Thu Oct  3 16:53:37 1996"
    ($junk, $junk, $junk, $junk, $year) = split(/\s+/, $unix_date);
    $century = substr($year, 0, 2);

    return($century);
}


1;				# need to return a true value


# ----------------------------------------------------------------------------
# $Log: common.pl,v $
# Revision 2.11  1997/05/06 01:00:26  curt
# Added patches contributed by Martin Schenk <schenkm@ping.at>
# - Default to umask of 066 so .CBB files get created rw by owner only
# - Added support for pgp encrypting data files
# - Added support for displaying only recent parts of files (avoids
#   waiting to load in lots of old txns you don't currently need.)
# - Added a feature to "cache" whole accounts in the perl engine so
#   that switching between accounts can be faster.
# - The above options can be turned on/off via the preferrences menu.
#
# Revision 2.10  1997/01/18 03:28:41  curt
# Added "use strict" pragma to enforce good scoping habits.
#
# Revision 2.9  1996/12/17 14:53:54  curt
# Updated copyright date.
#
# Revision 2.8  1996/12/11 18:33:30  curt
# Ran a spell checker.
#
# Revision 2.7  1996/10/03 22:02:25  curt
# I found a way in perl to get the century directly, so I was able to
# eliminate the dependency on the external Unix date command.
#
# Revision 2.6  1996/10/03 04:48:59  curt
# Fixed an inconsistency in &raw_date() in common.pl (with how it was
# called.)
#
# Version now is 0.67-beta-x
#
# Revision 2.5  1996/10/03 04:13:39  curt
# Refined default century handling code.
#
# Revision 2.4  1996/10/03 03:52:57  curt
# CBB now determines the current century automatically ... no need for it
# to be hard coded.  Removed all hardcoded instances of the century (especially
# in reports.pl and recur.pl)
#
# Added an optional --debug flag to the invocation of CBB.
#
# Revision 2.3  1996/10/02 19:37:18  curt
# Replaced instances of hardcoded century (19) with a variable.  We need to
# know the current century in cases where it is not provided and it is
# assumed to be the current century.  Someday I need to figure out how
# to determine the current century, but I have a couple of years to do it. :-)
#
# I still need to fix conf-reports and reports.pl
#
# Revision 2.2  1996/07/13 02:57:39  curt
# Version 0.65
# Packing Changes
# Documentation changes
# Changes to handle a value in both debit and credit fields.
#
# Revision 2.1  1996/02/27  05:35:37  curt
# Just stumbling around a bit with cvs ... :-(
#
# Revision 2.0  1996/02/27  04:41:50  curt
# Initial 2.0 revision.  (See "Log" files for old history.)