App-Chart
view release on metacpan or search on metacpan
use Locale::Messages;
use Locale::TextDomain 'App-Chart';
use App::Chart;
$|=1;
# uncomment this to run the ### lines
# use Smart::Comments;
if (@ARGV >= 1 && ($ARGV[0] eq '--subprocess' || $ARGV[0] eq '--emacs')) {
binmode (STDOUT, ':utf8') or die;
binmode (STDERR, ':utf8') or die;
} else {
# locale encoding conversion on the tty, wide-chars everywhere internally
require Encode::Locale;
require PerlIO::encoding;
unless (binmode(STDIN, ":encoding(console_in)")
&& binmode(STDOUT, ":encoding(console_out)")) {
warn "Cannot set :encoding on stdin/out: $!\n";
}
# Not sure coding on STDERR is a good idea, could loop trying to print.
# binmode(STDERR, ":encoding(console_out)")
# Old code:
#
# # version 0.06 for bug fix of a struct size for perl 5.10 (there's some
# # fragile duplication)
# require Encode; # Encode::PERLQQ
# require PerlIO::locale; PerlIO::locale->VERSION(0.06);
# { no warnings 'once';
# local $PerlIO::encoding::fallback = Encode::PERLQQ; # \x{1234} style
# (binmode (STDOUT, ':locale') && binmode (STDERR, ':locale'))
# or die "Cannot set :encoding on stdout/stderr: $!\n";
# }
# Makefile: 'PerlIO::locale' => '0.06',
# , libperlio-locale-perl (>= 0.06)
}
my $option_output;
my $option_mode;
my @args;
lib/App/Chart/Download.pm view on Meta::CPAN
return ($symbol);
}
}
sub command_line_download {
my ($class, $output, $args) = @_;
my $hash;
if ($output eq 'tty') {
if (-t STDOUT) {
binmode (STDOUT, ':via(EscStatus)')
or die 'Cannot push EscStatus';
} else {
require PerlIO::via::EscStatus::ShowNone;
binmode (STDOUT, ':via(EscStatus::ShowNone)')
or die 'Cannot push EscStatus::ShowNone';
}
} elsif ($output eq 'all-status') {
require PerlIO::via::EscStatus::ShowAll;
binmode (STDOUT, ':via(EscStatus::ShowAll)')
or die 'Cannot push EscStatus::ShowAll';
}
if (! @$args) {
print __"No symbols specified to download\n";
return;
}
my @symbol_list = ();
foreach my $arg (@$args) {
lib/App/Chart/EmacsMain.pm view on Meta::CPAN
return undef;
}
if (! defined POSIX::close ($file_fd)) { return undef; }
return $fd;
}
sub main {
my ($class) = @_;
# subprocess unbuffered and utf8
binmode (STDIN, ':utf8') or die;
# dup-ed to a new descriptor to talk to emacs
open $emacs_fh, '>&STDOUT' or die;
$emacs_fh->autoflush(1); # emacs_write() does single-string prints
# ENHANCE-ME: use one of the IO::Capture or via layer or whatnot to get
# perl prints to STDOUT/STDERR and send them up to an emacs buffer, or
# message area
#
# stdout/stderr fds 1 and 2 put to /dev/null to discard other prints
lib/App/Chart/Glib/Ex/DirBroadcast.pm view on Meta::CPAN
# as usual socket() and friends get FD_CLOEXEC set automatically, no need
# to do anything special to avoid propagating $listen_sock fd down to
# subprocess jobs
require Socket;
require IO::Socket;
my $listen_sock = $self->{'listen_sock'}
= do { local $^F = 0; # ensure close-on-exec for the socket
IO::Socket->new (Domain => Socket::AF_UNIX(),
Type => Socket::SOCK_DGRAM(),
Local => $listen_filename) };
binmode ($listen_sock, ':raw') or die;
### DirBroadcast listen: $listen_filename, $listen_sock->fileno
require Glib;
require App::Chart::Glib::Ex::MoreUtils;
require Glib::Ex::SourceIds;
$self->{'listen_source_ids'}
= Glib::Ex::SourceIds->new
(Glib::IO->add_watch ($listen_sock->fileno,
['in', 'hup', 'err'],
lib/App/Chart/Glib/Ex/DirBroadcast.pm view on Meta::CPAN
# open
$send_sock ||= do {
require IO::Socket;
require Socket;
my $sock = do {
local $^F = 0; # ensure close-on-exec for the socket
IO::Socket->new (Domain => Socket::AF_UNIX(),
Type => Socket::SOCK_DGRAM());
};
$sock->blocking(0);
binmode ($sock, ':raw') or die;
$sock
};
# put off freezing until we find someone to send to
if (! defined $frozen) {
require Storable;
$frozen = Storable::freeze ([$key, @data]);
if (length ($frozen) > MAXLEN) {
croak 'DirBroadcast: message too long: ',length($frozen);
}
lib/App/Chart/Gtk2/IntradaySave.pm view on Meta::CPAN
my $dbh = App::Chart::DBI->instance;
my $sth = $dbh->prepare_cached
('SELECT image, error FROM intraday_image WHERE symbol=? AND mode=?');
my ($blob, $error) = $dbh->selectrow_array
($sth, undef, $self->{'symbol'}, $self->{'mode'});
$sth->finish();
if (defined $blob) {
my $filename = $self->get_filename;
open my $fh, '>', $filename or die;
binmode ($fh) or die;
print $fh $blob or die;
close $fh or die;
} else {
my $msg = Gtk2::MessageDialog->new ($self,
['modal','destroy-with-parent'],
'error',
'ok',
"No image to save: %s",
$error||__('(No data)'));
$msg->signal_connect (response => sub {
lib/App/Chart/SubprocessMain.pm view on Meta::CPAN
# set this to 1 for development debugging prints
use constant { DEBUG => 0,
DEBUG_TTY_FILENAME => '/dev/tty' };
sub main {
my ($class) = @_;
## no critic (ProhibitExplicitStdin, ProhibitExit)
# subprocess unbuffered and utf8
binmode (STDIN, ':raw') or die;
*STDOUT->autoflush(1);
*STDERR->autoflush(1);
if (DEBUG) {
## no critic (ProhibitBarewordFileHandles RequireBriefOpen)
open TTY, '>', DEBUG_TTY_FILENAME or die;
print TTY "SubprocessMain\n";
*TTY->autoflush(1);
}
lib/App/Chart/Vacuum.pm view on Meta::CPAN
use constant VACUUM_AGE_DAYS => 14;
my $verbose = 0;
sub command_line_vacuum {
my ($class, $output, $args) = @_;
if ($output eq 'tty') {
if (-t STDOUT) {
binmode (STDOUT, ':via(EscStatus)')
or die 'Cannot push EscStatus';
} else {
require PerlIO::via::EscStatus::ShowNone;
binmode (STDOUT, ':via(EscStatus::ShowNone)')
or die 'Cannot push EscStatus::ShowNone';
}
} elsif ($output eq 'all-status') {
require PerlIO::via::EscStatus::ShowAll;
binmode (STDOUT, ':via(EscStatus::ShowAll)')
or die 'Cannot push EscStatus::ShowAll';
}
my %option;
foreach my $arg (@$args) {
if ($arg =~ /^no-?/ip) {
$option{${^POSTMATCH}} = 0;
} else {
$option{$arg} = 1;
}
misc/t-latest.pl view on Meta::CPAN
#
# You should have received a copy of the GNU General Public License along
# with Chart. If not, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
# use Gtk2 '-init';
# use App::Chart::Gtk2::Symlist;
use App::Chart::Latest;
binmode(STDOUT,":encoding(latin-1)") or die;
{
# App::Chart::Latest->get ()
# from the database
my $symbol = 'AUDZAR.RBA';
$symbol = 'HGI.AX';
$symbol = 'STO.AX';
$symbol = 'SXA.MON';
$symbol = 'NOSUCH.AX';
misc/t-misc.pl view on Meta::CPAN
foreach my $name (@Encode::FB_FLAGS) {
my $value = eval "$name";
printf "%-20s %#05X\n", $name, $value;
}
require PerlIO::encoding;
local $PerlIO::encoding::fallback = 0; # FB_DEFAULT, substitute quietly
local $PerlIO::encoding::fallback = Encode::PERLQQ;
printf "fallback %#x\n",$PerlIO::encoding::fallback;
binmode (STDOUT, ":encoding(latin-1)");
my $str = "\b\x{263a}\n";
print "len ", length($str),"\n";
$| = 1;
print $str;
$str = "\r\r\r\n";
print "len ", length($str),"\n";
$| = 1;
print $str;
exit 0;
misc/t-yahoo.pl view on Meta::CPAN
my $h = App::Chart::Yahoo::exchanges_data ();
print Dumper(\$h);
exit 0;
}
{
# exchanges_parse() from file
#
my $filename = $ENV{'HOME'}.'/chart/samples/yahoo/exchanges.html';
$filename = $ENV{'HOME'}.'/chart/samples/yahoo/SLN2310.html';
$filename = $ENV{'HOME'}.'/chart/samples/yahoo/exchanges-data-providers-yahoo-finance-sln2310.html';
my $decoded_content = File::Slurp::read_file ($filename, {binmode => ':utf8'});
my $h = App::Chart::Yahoo::exchanges_parse ($decoded_content);
print Dumper(\$h);
exit 0;
}
{
# v8 download size
# https://query2.finance.yahoo.com/v8/finance/chart/TSCO.L?period1=1701140528&period2=1718766128&interval=1d&events=div%7Csplit
# &corsDomain=finance.yahoo.com
misc/zip.pl view on Meta::CPAN
my $SH = IO::String->new($zipContents);
my $zip = Archive::Zip->new();
my $member = $zip->addString('a' x 300, 'bunchOfAs.txt');
$member->desiredCompressionMethod(COMPRESSION_DEFLATED);
$member = $zip->addString('b' x 300, 'bunchOfBs.txt');
$member->desiredCompressionMethod(COMPRESSION_DEFLATED);
my $status = $zip->writeToFileHandle( $SH );
my $file = IO::File->new('test.zip', 'w');
binmode($file);
$file->print($zipContents);
$file->close();
misc/zip2.pl view on Meta::CPAN
my $cont = $m->contents;
print Dumper (\$cont);
# my $member = $zip->addString('a' x 300, 'bunchOfAs.txt');
# $member->desiredCompressionMethod(COMPRESSION_DEFLATED);
# $member = $zip->addString('b' x 300, 'bunchOfBs.txt');
# $member->desiredCompressionMethod(COMPRESSION_DEFLATED);
# my $status = $zip->writeToFileHandle( $SH );
# my $file = IO::File->new('test.zip', 'w');
# binmode($file);
# $file->print($zipContents);
# $file->close();
( run in 0.524 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )