File Coverage

blib/lib/App/JobLog/Config.pm

Criterion	Covered	Total	%
statement	139	145	95.8
branch	27	36	75.0
condition	20	31	64.5
subroutine	39	40	97.5
pod	17	18	94.4
total	242	270	89.6

package App::JobLog::Config;
$App::JobLog::Config::VERSION = '1.040';
# ABSTRACT: central depot for App::JobLog configuration parameters and controller allowing their modification


use Exporter 'import';
our @EXPORT_OK = qw(
  columns
  day_length
  dir
  editor
  hidden_columns
  init_file
  is_hidden
  is_workday
  log
  merge
  pay_period_length
  precision
  readme
  start_pay_period
  sunday_begins_week
  time_zone
  _tz
  vacation
  workdays
  DAYS
  DIRECTORY
  HIDABLE_COLUMNS
  HOURS
  MERGE
  NONE_COLUMN
  PERIOD
  PRECISION
  SUNDAY_BEGINS_WEEK
  TIME_ZONE
  WORKDAYS
);

use Class::Autouse qw{
  File::HomeDir
  File::Spec
  Config::Tiny
  FileHandle
  App::JobLog::Command::info
};
use autouse 'File::Path'    => qw(mkpath);
use autouse 'Cwd'           => qw(abs_path);
use autouse 'Term::ReadKey' => qw(GetTerminalSize);
use Modern::Perl;

# default precision
use constant PRECISION => 2;

# default pay period
use constant PERIOD => 14;

# hours worked in day
use constant HOURS => 8;

# whether Sunday is the first day of the week
# otherwise it's Monday, as in DateTime
use constant SUNDAY_BEGINS_WEEK => 1;

# environment variables

# identifies directory to write files into
use constant DIRECTORY => 'JOB_LOG_DIRECTORY';

# expected abbreviations for working days in week
use constant WORKDAYS => 'MTWHF';

# expected abbreviations for weekdays
use constant DAYS => 'S' . WORKDAYS . 'A';

# default level of merging
use constant MERGE => 'adjacent same tags';

# name of hide nothing "column"
use constant NONE_COLUMN => 'none';

# array of hidable columns
use constant HIDABLE_COLUMNS => [
    NONE_COLUMN, qw(
      date
      description
      duration
      tags
      time
      )
];

# default time zone; necessary because Cygwin doesn't support local
use constant TIME_ZONE => $^O eq 'cygwin' ? 'floating' : 'local';


sub init_file {
    my ($path) = @_;
    unless ( -e $path ) {
        my ( $volume, $directories, $file ) = File::Spec->splitpath($path);
        my $dir = File::Spec->catfile( $volume, $directories );
        mkpath( $dir, { verbose => 0, mode => 0711 } ) unless -d $dir;
        unless ( -e readme() ) {
            my $fh = FileHandle->new( readme(), 'w' )
              or die 'could not create file ' . readme();
            my $executable = abs_path($0);

            # to protect against refactoring
            my $command = App::JobLog::Command::info->name;
            print $fh <

Job Log

This directory holds files used by Job Log to maintain
a work log. For more details type

$executable $command

on the command line.

END
            $fh->close;
        }
    }
}


my $dir;

sub dir {
    $dir ||= $ENV{ DIRECTORY() };
    $dir ||= File::Spec->catfile( File::HomeDir->my_home, '.joblog' );
    return $dir;
}


my $log;

sub log {
    $log ||= File::Spec->catfile( dir(), 'log' );
    return $log;
}


my $readme;

sub readme {
    $readme ||= File::Spec->catfile( dir(), 'README' );
    return $readme;
}

# configuration file for basic parameters
my $config_file;

sub _config_file {
    $config_file ||= File::Spec->catfile( dir(), 'config.ini' );
    return $config_file;
}


my $vacation_file;

sub vacation {
    $vacation_file ||= File::Spec->catfile( dir(), 'vacation' );
    return $vacation_file;
}

# configuration object and whether any changes need to be written to this file
my ( $config, $config_changed );

END {
    if ($config_changed) {
        init_file( _config_file() );
        $config->write( _config_file() );
    }
}

# construct configuration object as necessary
sub _config {
    unless ($config) {
        my $f = _config_file();
        $config = -e $f ? Config::Tiny->read($f) : Config::Tiny->new;
    }
    return $config;
}


sub precision {
    my ($value) = @_;
    return _param( 'precision', PRECISION, 'summary', $value );
}

sub merge {
    my ($value) = @_;
    return _param( 'merge', MERGE, 'summary', $value );
}


sub day_length {
    my ($value) = @_;
    return _param( 'day-length', HOURS, 'time', $value );
}


sub pay_period_length {
    my ($value) = @_;
    return _param( 'pay-period-length', PERIOD, 'time', $value );
}


sub sunday_begins_week {
    my ($value) = @_;
    return _param( 'sunday-begins-week', SUNDAY_BEGINS_WEEK, 'time', $value );
}


sub start_pay_period {
    my ($value) = @_;
    require DateTime;
    if ( ref $value eq 'DateTime' ) {
        $value = sprintf '%d %d %d', $value->year, $value->month, $value->day;
    }
    $value = _param( 'start-pay-period', undef, 'time', $value );
    if ($value) {
        my @parts = split / /, $value;
        return DateTime->new(
            year      => $parts[0],
            month     => $parts[1],
            day       => $parts[2],
            time_zone => _tz(),
        );
    }
    return;
}

# abstracts out code for maintaining config file
sub _param {
    my ( $param, $default, $section, $new_value ) = @_;
    $section ||= 'main';
    my $config = _config();
    my $value  = $config->{$section}->{$param};
    if ( defined $new_value ) {
        if ( defined $default && $new_value eq $default && !defined $value ) {
            return $new_value;
        }
        return $value if defined $value && $value eq $new_value;
        $config_changed = 1;
        return $config->{$section}->{$param} = $new_value;
    }
    else {
        return defined $value ? $value : $default;
    }
}


sub editor {
    my ($value) = @_;
    $value = _param( 'editor', undef, 'external', $value );
    return $value;
}


sub columns {
    my ($cols) = GetTerminalSize;
    $cols ||= 76;
    return $cols;
}


sub workdays {
    my ($value) = @_;
    return _param( 'workdays', WORKDAYS, 'time', $value );
}


my %workdays;

sub is_workday {
    my ($date) = @_;

    # initialize map
    unless (%workdays) {
        my @days = split //, DAYS;

        # move Sunday into DateTime's expected position
        push @days, shift @days;
        my %day_map;
        for ( 0 .. $#days ) {
            $day_map{ $days[$_] } = $_ + 1;
        }
        for ( split //, workdays() ) {
            $workdays{ $day_map{$_} } = 1;
        }
    }
    return $workdays{ $date->day_of_week };
}


sub hidden_columns {
    my ($value) = @_;
    return _param( 'hidden_columns', NONE_COLUMN, 'summary', $value );
}


my %hidden_columns;

sub is_hidden {
    my ($value) = @_;
    unless (%hidden_columns) {
        %hidden_columns = map { $_ => 1 } split / /, hidden_columns();
    }
    return $hidden_columns{$value};
}


sub time_zone {
    my ($value) = @_;
    return _param( 'time_zone', TIME_ZONE, 'time', $value );
}

our $tz;

# removed from App::JobLog::Time to prevent dependency cycle
sub _tz {
    if ( !defined $tz ) {
        require DateTime::TimeZone;
        eval { $tz = DateTime::TimeZone->new( name => time_zone() ) };
        if ($@) {
            print STDERR 'DateTime::TimeZone doesn\'t like the time zone '
              . time_zone()
              . "\nreverting to floating time\n full error: $@";
            $tz = DateTime::TimeZone->new( name => 'floating' );
        }
    }
    return $tz;
}

1;

__END__