view release on metacpan or  search on metacpan

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

# 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);
}

sub symbol_suffix {
  my ($symbol) = @_;
  if ($symbol =~ /([.=][^.=]+)$/) {
    return $1;
  } else {
    return '';
  }
}

my $symbol_re = qr{
                   ((\ (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\ |
                       \^?[^^]([FGHJKMNQUVXZ]))  # $4 M code
                     ([0-9]+)                    # $5 year
                   | ([0-9]+))?                  # $6 number like LME
                   (\.[^.]+)?$                   # $7 suffix
                }ix;

# return commodity part of SYMBOL, or whole symbol (sans suffix) if no
# month/year
# eg. "GC" for "GCH05.CMX"
#     "TIN 3" for "TIN 3.LME"  -- ?????
sub symbol_commodity {
  my ($symbol) = @_;
  $symbol =~ $symbol_re or die 'Oops, symbol_re didn\'t match';
  my $end = ($+[6]        # "TIN 3" num right up to suffix
             // $-[4]     # "X08" M-code stop there