view release on metacpan or  search on metacpan

lib/App/Chart.pm  view on Meta::CPAN

# Copyright 2007, 2008, 2009, 2010, 2011, 2012, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2023, 2024 Kevin Ryde

# This file is part of Chart.
#
# Chart 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 3, or (at your option) any later version.
#
# Chart 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 Chart.  If not, see <http://www.gnu.org/licenses/>.

package App::Chart;
use 5.010;
use strict;
use warnings;
use Carp;
use Date::Calc;
use File::Spec;
use List::Util qw(min max);
use POSIX qw(floor ceil);
use Regexp::Common 'whitespace';
use Scalar::Util;
use Locale::TextDomain;
use Locale::TextDomain ('App-Chart');
use Glib;

# uncomment this to run the ### lines
#use Smart::Comments;

our $VERSION = 275;

use Locale::Messages 1.16; # version 1.16 for turn_utf_8_on()
BEGIN {
  Locale::Messages::bind_textdomain_codeset ('App-Chart','UTF-8');
  Locale::Messages::bind_textdomain_filter ('App-Chart',
                                            \&Locale::Messages::turn_utf_8_on);
}
# sub chart_gettext_filter {
#   my ($str) = @_;
#   Locale::Messages::turn_utf_8_on ($str);
#   $str =~ s/^CONTEXT\(.*?\): *//;
#   return $str;
# }

# Return the user's ~/Chart directory, as an absolute path in filesystem
# charset encoding.
# Note not using Glib::get_home_dir() here, since it wrongly prefers 
# /etc/passwd file over $HOME.
use constant::defer chart_directory => sub {
  if (defined $ENV{'CHART_DIRECTORY'}) {
    return $ENV{'CHART_DIRECTORY'}
  } else {
    require File::HomeDir;
    my $home = File::HomeDir->my_home
      // die "No home directory can be found by File::HomeDir\n";
    return File::Spec->catdir($home, 'Chart');
  }
};

use constant::defer chart_dirbroadcast => sub {
  require App::Chart::Glib::Ex::DirBroadcast;
  return App::Chart::Glib::Ex::DirBroadcast->new
    (File::Spec->catdir(chart_directory(), 'broadcast'));
};

# force LC_NUMERIC to the locale, whereas perl normally runs with "C"
use constant::defer number_formatter => sub {
  require Number::Format;
  my $oldlocale = POSIX::setlocale(POSIX::LC_NUMERIC());
  POSIX::setlocale (POSIX::LC_NUMERIC(), "");
  my $nf = Number::Format->new;
  POSIX::setlocale (POSIX::LC_NUMERIC(), $oldlocale);
  return $nf;
};

use constant { UP_COLOUR   => 'light green',
                 DOWN_COLOUR => 'pink',
                 BAND_COLOUR => 'blue',
                 GREY_COLOUR => 'grey' };

#------------------------------------------------------------------------------

our %option
  = (verbose => 0,
     d_fmt   => do {
       # langinfo D_FMT if available, otherwise fallback to a neutral YYYY-MM-DD
       eval {
         require I18N::Langinfo;
         require I18N::Langinfo::Wide;
         I18N::Langinfo::Wide::langinfo(I18N::Langinfo::D_FMT())
         }
         || '%Y-%m-%d'
       },
     http_get_cost => 3000,
    );
$option{'wd_fmt'} = __x('%a {d_fmt}', d_fmt => $option{'d_fmt'});



#------------------------------------------------------------------------------

sub symbol_sans_suffix {
  my ($symbol) = @_;
  return ($symbol =~ /(.*)\./ ? $1 : $symbol);
}

lib/App/Chart.pm  view on Meta::CPAN

}
sub ymd_to_tdate_ceil {
  my ($year, $month, $day) = @_;
  return adate_to_tdate_ceil (ymd_to_adate ($year, $month, $day));
}


#------------------------------------------------------------------------------

sub collapse_whitespace {
  my ($str) = @_;
  $str =~ s/\x{A0}+/ /g;       # latin1/unicode non-breaking space
  $str =~ s/$RE{ws}{crop}//g;  # leading and trailing whitespace
  $str =~ s/\s+/ /g;           # middle whitespace
  return $str;
}

#------------------------------------------------------------------------------

sub decimal_sub {
  my ($x, $y) = @_;
  # would prefer an actual decimal-arithmetic subtract here
  my $decimals = max (count_decimals($x), count_decimals($y));
  return sprintf ('%.*f', $decimals, $x - $y);
}

#------------------------------------------------------------------------------

sub count_decimals {
  my ($str) = @_;
  my $pos = index ($str, '.');
  if ($pos >= 0) {
    return length($str) - $pos - 1;
  } else {
    return 0;
  }
}

#------------------------------------------------------------------------------

# Return min or max of the arguments, ignoring any undefs.
# If no args (no undefs that is) then return undef.
# List::Util min() and max() return undef for no args, but they want all args
# to be numeric.
#
sub min_maybe {
  return min (grep {defined} @_);
}
sub max_maybe {
  return max (grep {defined} @_);
}

#------------------------------------------------------------------------------

# App::Chart::datafilename ($filename)
# App::Chart::datafilename ($dir,...,$dir, $filename)
#
# Return an absolute path like /usr/share/perl5/App/Chart/$filename,
# wherever App/Chart/$filename is found in @INC.  $dir arguments specify a
# subdirectory like App/Chart/$dir1/$dir2/$filename.  All args and the
# return are in filesystem charset bytes.
#
# Module::Find and Module::Util have similar @INC searches, but only for .pm
# files it seems.
#
sub datafilename {
  foreach my $inc (@INC) {
    my $filename = File::Spec->catfile ($inc, 'App', 'Chart', @_);
    if (-e $filename) { return $filename; }
  }
  require File::Basename;
  return File::Spec->catfile (File::Basename::dirname($INC{'App/Chart.pm'}),
                              'Chart', @_);
}

# return true if range ($alo,$ahi) overlaps range ($blo,$bhi)
# each endpoint is taken as inclusive, so say (1,4) and (4,7) do overlap
#
sub overlap_inclusive_p {
  my ($alo, $ahi, $blo, $bhi) = @_;
  return ! ($ahi < $blo || $alo > $bhi);
}

1;
__END__

=head1 NAME

App::Chart -- various shared Chart things

=head1 SYMBOL FUNCTIONS

=over 4

=cut

=item C<< %App::Chart::option >>

Various program options.

=over 4

=item C<verbose> (default false)

Print more things (mainly during downloads).  This is the C<--verbose>
command line option.

=item C<d_fmt> (default from C<langinfo()>)

C<strftime> format string for a date.  Non-ASCII can be included as Perl
wide-chars.

The default is from C<langinfo(D_FMT)> if the L<I18N::Langinfo> and
L<I18N::Langinfo::Wide> modules are available.  Otherwise the default is
C<%Y-%m-%d> which gives an ISO style YYYY-MM-DD.

=item C<wd_fmt> (default C<%a> and C<d_fmt>)

C<strftime> format string for a weekday name and date.

=item C<http_get_cost> (default 3000)