"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "perldl" between
PDL-2.076.tar.gz and PDL-2.077.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

perldl  (PDL-2.076):perldl  (PDL-2.077)
skipping to change at line 180 skipping to change at line 180
-I <dir> Add <dir> to include path. -I <dir> Add <dir> to include path.
-V print PDL version info (e.g. for a bug report) -V print PDL version info (e.g. for a bug report)
- Following arguments are files for input. - Following arguments are files for input.
EOP EOP
die("Unknown argument $_"); die("Unknown argument $_");
} }
} }
my $readlines; my $readlines = 0;
if(!$read_from_file and -t STDIN) { if(!$read_from_file and -t STDIN) {
eval "use Term::ReadLine"; eval "use Term::ReadLine";
$readlines = ($@ eq ""); if ( $readlines = !$@ ) {
} else { $PERLDL::TERM = Term::ReadLine->new('perlDL', \*STDIN, \*STDOUT);
$readlines=0; readhist();
$PERLDL::TERM->GetHistory if $PERLDL::TERM->can('GetHistory'); # if don't do
this before loading OpenGL, it can load libedit via LLVM which has C symbol cla
shes with GNU readline
}
} }
my @enabled = (); my @enabled = ();
push @enabled, "ReadLines" if $readlines; push @enabled, "ReadLines" if $readlines;
eval 'use PDL::NiceSlice'; eval 'use PDL::NiceSlice';
unless ($@) { unless ($@) {
my $report = 0; my $report = 0;
sub report { sub report {
my $ret = $report; my $ret = $report;
skipping to change at line 215 skipping to change at line 217
preproc_add $preproc unless preproc_registered $preproc; preproc_add $preproc unless preproc_registered $preproc;
preproc_del $preproc if $#_ > -1 && !$_[0] && preproc_del $preproc if $#_ > -1 && !$_[0] &&
preproc_registered $preproc; preproc_registered $preproc;
} }
sub notrans { trans 0 } sub notrans { trans 0 }
trans; # switch on by default trans; # switch on by default
push @enabled, "NiceSlice"; push @enabled, "NiceSlice";
} }
use Text::Balanced; use Text::Balanced;
push @enabled,"MultiLines"; push @enabled, "MultiLines";
my $interrupt_handle = eval 'use Sys::SigAction qw(set_sig_handler); 1';
my $interrupt_msg = "Ctrl-C detected";
if ($interrupt_handle) {
push @enabled, "Interrupt";
} else {
$SIG{'INT'} = sub { die "$interrupt_msg\n" }; # Ctrl-C handler
}
sub mksighandle {
$interrupt_handle ? set_sig_handler(INT => sub {
die "$interrupt_msg\n";
}) : undef;
}
print join(', ',@enabled)," enabled\n" if @enabled > 0; print join(', ',@enabled)," enabled\n" if @enabled > 0;
if ( $readlines ){ if ( $readlines ){
$PERLDL::TERM = Term::ReadLine->new('perlDL', \*STDIN, \*STDOUT);
if (defined &OpenGL::GLUT::done_glutInit ) { if (defined &OpenGL::GLUT::done_glutInit ) {
# Attempt to use with FreeGLUT # Attempt to use with FreeGLUT
if ($PERLDL::TERM->can('event_loop')) { if ($PERLDL::TERM->can('event_loop')) {
print "Using FreeGLUT event loop\n"; print "Using FreeGLUT event loop\n";
# Presumably, if you're using this loop, you're also selecting on othe r # Presumably, if you're using this loop, you're also selecting on othe r
# fileno's. It is up to you to add that in to the wait callback (firs t # fileno's. It is up to you to add that in to the wait callback (firs t
# one passed to event_loop) and deal with those file handles. # one passed to event_loop) and deal with those file handles.
$PERLDL::TERM->event_loop( $PERLDL::TERM->event_loop(
sub { sub {
skipping to change at line 271 skipping to change at line 284
} }
if(defined &Tk::DoOneEvent and not ref $Term::ReadLine::toloop) { if(defined &Tk::DoOneEvent and not ref $Term::ReadLine::toloop) {
# Attempt to use with Tk # Attempt to use with Tk
if(${$PERLDL::TERM->Features}{tkRunning}) { if(${$PERLDL::TERM->Features}{tkRunning}) {
print "Using Tk event loop\n"; print "Using Tk event loop\n";
$PERLDL::TERM->tkRunning(1); $PERLDL::TERM->tkRunning(1);
} else { } else {
warn("Sorry, cannot use Tk with this version of ReadLine\n"); warn("Sorry, cannot use Tk with this version of ReadLine\n");
} }
} }
}
sub readhist {
if ( ( -e "$HOME/.perldl_hist" ) if ( ( -e "$HOME/.perldl_hist" )
&& ( open HIST, "<$HOME/.perldl_hist" ) ) { && ( open HIST, "<$HOME/.perldl_hist" ) ) {
my @allhist = <HIST>; my @allhist = <HIST>;
close HIST; close HIST;
map s/\n//g , @allhist ; map s/\n//g , @allhist ;
foreach (@allhist) { foreach (@allhist) {
$PERLDL::TERM->addhistory($_); $PERLDL::TERM->addhistory($_);
} }
} }
eval <<'EOEND'; }
sub END { sub savehist {
return if !$readlines;
# Save History in $ENV{'HOME'}/.perldl_hist # Save History in $ENV{'HOME'}/.perldl_hist
# GetHistory doesn't work on all versions... # GetHistory doesn't work on all versions...
my @a= $PERLDL::TERM->GetHistory() if $PERLDL::TERM->can('GetHistory'); return if !$PERLDL::TERM->can('GetHistory');
my @a= grep $_ && /\S/, $PERLDL::TERM->GetHistory;
$#a-- if $a[-1] =~ /^(q$|x$|\s*exit\b|\s*quit\b)/; # chop off the exit comma pop @a if $a[-1] =~ /^(q$|x$|\s*exit\b|\s*quit\b)/; # chop off the exit comm
nd and
@a= @a[($#a-$PERLDL::HISTFILESIZE+1)..($#a)] if $#a > $PERLDL::HISTFILESIZE- return if !@a; # nothing to do (and don't overwrite)
1 ; @a = map {s/^\s*(.*?)\s*$/$1/;$_} @a; # strip whitespace
my %seen; @a = reverse grep !$seen{$_}++, reverse @a; # dedup
@a= @a[(@a-$PERLDL::HISTFILESIZE)..($#a)] if @a > $PERLDL::HISTFILESIZE;
if( open HIST, ">$HOME/.perldl_hist" ) { if( open HIST, ">$HOME/.perldl_hist" ) {
print HIST join("\n",@a); print HIST join("\n",@a);
close HIST; close HIST;
} else { } else {
print " Unable to open \"$HOME/.perldl_hist\"\n"; print " Unable to open \"$HOME/.perldl_hist\"\n";
} }
} }
EOEND
}
sub l { sub l {
if ($readlines) { if ($readlines) {
my $n = $#_ > -1 ? shift : 20; my $n = $#_ > -1 ? shift : 20;
my @h = $PERLDL::TERM->GetHistory(); my @h = $PERLDL::TERM->GetHistory();
my $min = $#h < $n-1 ? 0 : $#h-$n+1; my $min = $#h < $n-1 ? 0 : $#h-$n+1;
map {print "$_: $h[$_]\n"} ($min..$#h); map {print "$_: $h[$_]\n"} ($min..$#h);
} }
} }
sub with_time (&) {
require Time::HiRes;
my @t = Time::HiRes::gettimeofday();
&{$_[0]}();
printf "%g ms\n", Time::HiRes::tv_interval(\@t) * 1000;
}
sub page { sub page {
$PERLDL::PAGE = (defined $_[0] ? $_[0] : 1); $PERLDL::PAGE = (defined $_[0] ? $_[0] : 1);
} }
sub nopage { sub nopage {
page(0); page(0);
} }
sub startpage { sub startpage {
if ($PERLDL::PAGE) { if ($PERLDL::PAGE) {
open(SAVEOUT, '>&STDOUT'); open(SAVEOUT, '>&STDOUT');
open(STDOUT, "| $PERLDL::PAGER"); open(STDOUT, "| $PERLDL::PAGER");
skipping to change at line 386 skipping to change at line 410
if (-e 'local.perldlrc') { if (-e 'local.perldlrc') {
print "Reading local.perldlrc ...\n"; print "Reading local.perldlrc ...\n";
require 'local.perldlrc' ; require 'local.perldlrc' ;
} }
# Short hand for some stuff # Short hand for some stuff
sub p { local $^W=0; print(@_); } # suppress possible undefined var message sub p { local $^W=0; print(@_); } # suppress possible undefined var message
# (dirty) # (dirty)
my %demos = use PDL::Demos;
(
'pdl' => 'PDL::Demos::General', # have to protect pdl as it means something
'3d' => 'PDL::Demos::TriD1',
'3d2' => 'PDL::Demos::TriD2',
'3dgal' => 'PDL::Demos::TriDGallery',
'pgplot' => 'PDL::Demos::PGPLOT_demo',
'ooplot' => 'PDL::Demos::PGPLOT_OO_demo', # note: lowercase
'bad' => 'PDL::Demos::BAD_demo',
'bad2' => 'PDL::Demos::BAD2_demo',
'transform' => 'PDL::Demos::Transform_demo',
'cartography' => 'PDL::Demos::Cartography_demo',
'gnuplot' => 'PDL::Demos::Gnuplot_demo',
'prima' => 'PDL::Demos::Prima',
);
sub demo { sub demo {
local $_ = lc $_[0] ; if (!$_[0]) {
if(/^$/) { require List::Util;
print <<EOD; my @kw = sort grep $_ ne 'pdl', PDL::Demos->keywords;
Use: my $maxlen = List::Util::max(map length, @kw);
demo pdl # general demo print "Use:\n";
printf " demo %-${maxlen}s # %s\n", @$_[0,1] for map [PDL::Demos->info($_)
demo 3d # 3d demo (requires TriD with OpenGL or Mesa) ], 'pdl', @kw;
demo 3d2 # 3d demo, part 2. (Somewhat memory-intensive)
demo 3dgal # the 3D gallery: make cool images with 3-line scripts
demo pgplot # PGPLOT graphics output (Req.: PGPLOT)
demo OOplot # PGPLOT OO interface (Req.: PGPLOT)
demo gnuplot # Gnuplot graphics (requires PDL::Graphics::Gnuplot)
demo prima # Prima graphics (requires PDL::Graphics::Prima)
demo transform # Coordinate transformations (Req.: PGPLOT)
demo cartography # Cartographic projections (Req.: PGPLOT)
demo bad # Bad-value demo
demo bad2 # Bad-values, part 2 (Req.: PGPLOT)
EOD
return; return;
} # if: /^$/ }
no strict;
if ( exists $demos{$_} ) { PDL::Demos->init($_[0]);
require PDL::Demos::Screen; # Get the routines for screen demos. $_->[0]->($_->[1]) for PDL::Demos->demo($_[0]);
my $name = $demos{$_}; PDL::Demos->done($_[0]);
eval "require $name;"; # see docs on require for need for eval }
$name .= "::run";
&{$name}();
} else {
print "No such demo!\n";
}
} # sub: demo
$SIG{'INT'} = sub { die "Ctrl-C detected\n" }; # Ctrl-C handler
my $preproc_warned = 0; my $preproc_warned = 0;
sub preproc_oldwarn { sub preproc_oldwarn {
warn << 'EOW'; warn << 'EOW';
Deprecated usage: $PERLDL::PREPROCESS was set. Deprecated usage: $PERLDL::PREPROCESS was set.
Usage of this variable is now strongly deprecated. Usage of this variable is now strongly deprecated.
To enable preprocessing with recent versions of perldl To enable preprocessing with recent versions of perldl
you should use the 'preproc_add' function. For details you should use the 'preproc_add' function. For details
check the perldl manpage. check the perldl manpage.
skipping to change at line 545 skipping to change at line 528
multiline: { multiline: {
my $cont; my $cont;
$lines = ""; $lines = "";
do { do {
local $, = ""; local $, = "";
my $prompt = $cont ? "..$cont".(" "x(5-length($cont)))."> " : my $prompt = $cont ? "..$cont".(" "x(5-length($cont)))."> " :
((ref $PERLDL::PROMPT) ? &$PERLDL::PROMPT : $PERLDL::PROMPT); ((ref $PERLDL::PROMPT) ? &$PERLDL::PROMPT : $PERLDL::PROMPT);
if ($readlines) { {
$_ = $PERLDL::TERM->readline($prompt); my $sig_action = mksighandle();
}else{ if ($readlines) {
print $prompt if(-t ARGV); # Don't print prompt in pipes $_ = $PERLDL::TERM->readline($prompt);
$_ = <>; }else{
print $prompt if(-t ARGV); # Don't print prompt in pipes
$_ = <>;
}
} }
if(!defined $_) { if(!defined $_) {
if($cont) { if($cont) {
if( $PERLDL::NO_EOF > 1 && -t STDIN ) { if( $PERLDL::NO_EOF > 1 && -t STDIN ) {
print STDERR "\nEOF ignored. (Close delimiters to end block . \$PERLDL::NO_EOF = $PERLDL::NO_EOF)\n"; print STDERR "\nEOF ignored. (Close delimiters to end block . \$PERLDL::NO_EOF = $PERLDL::NO_EOF)\n";
} else { } else {
last multiline; last multiline;
} }
} else { } else {
if($PERLDL::NO_EOF && -t STDIN ) { if($PERLDL::NO_EOF && -t STDIN ) {
print STDERR "EOF ignored. ('q' or 'exit' to quit. \$PERLDL ::NO_EOF = $PERLDL::NO_EOF)\n"; print STDERR "EOF ignored. ('q' or 'exit' to quit. \$PERLDL ::NO_EOF = $PERLDL::NO_EOF)\n";
} else { } else {
print STDERR "EOF detected, exiting shell.\n"; print STDERR "EOF detected, exiting shell.\n";
savehist();
exit 0; exit 0;
} }
} }
} }
$lines .= "\n" if($cont); # Make multi-line strings work right. $lines .= "\n" if($cont); # Make multi-line strings work right.
$lines .= $_; $lines .= $_;
print "lines = $lines\n" if($PERLDL::debug); print "lines = $lines\n" if($PERLDL::debug);
} while( $PERLDL::MULTI && ($cont = count_tags($lines)) ); } while( $PERLDL::MULTI && ($cont = count_tags($lines)) );
skipping to change at line 590 skipping to change at line 577
warn $mess if $mess; warn $mess if $mess;
} }
# Filter out PDL shell prefixes from cut-n-pasted lines # Filter out PDL shell prefixes from cut-n-pasted lines
if ( $lines =~ s/$PERLDL::PREFIX_RE// and $readlines ) { if ( $lines =~ s/$PERLDL::PREFIX_RE// and $readlines ) {
my @hist = $PERLDL::TERM->GetHistory(); my @hist = $PERLDL::TERM->GetHistory();
foreach my $entry (@hist) { $entry =~ s/$PERLDL::PREFIX_RE//; } foreach my $entry (@hist) { $entry =~ s/$PERLDL::PREFIX_RE//; }
$PERLDL::TERM->SetHistory(@hist); $PERLDL::TERM->SetHistory(@hist);
} }
if(!defined $lines || lc $lines eq 'q' || lc $lines eq 'x' || lc $lines eq 'qu it') {exit}; if(!defined $lines || lc $lines eq 'q' || lc $lines eq 'x' || lc $lines eq 'qu it') {savehist(); exit;};
next if $lines =~/^\s*$/; # Blank line - do nothing next if $lines =~/^\s*$/; # Blank line - do nothing
$lines =~ s/^\s*\?\?\s*/apropos /; # Make '??' = 'apropos' $lines =~ s/^\s*\?\?\s*/apropos /; # Make '??' = 'apropos'
$lines =~ s/^\s*\?\s*/help /; # Make lone '?' = 'help' $lines =~ s/^\s*\?\s*/help /; # Make lone '?' = 'help'
if ( $lines =~ /^\s*(help|usage|apropos|sig|badinfo|demo)\s+/) { # Allow help foo (no quotes) if ( $lines =~ /^\s*(help|usage|apropos|sig|badinfo|demo)\s+/) { # Allow help foo (no quotes)
my @t = split(/\s+/,$lines); my @t = split(/\s+/,$lines);
my $x; my $x;
foreach $x(@t) { $x=~s/^["']+//; $x=~s/['"]+$//; }; foreach $x(@t) { $x=~s/^["']+//; $x=~s/['"]+$//; };
$t[1] = "'".$t[1]."'" if ($#t == 1 && !($t[1] =~ /^\$/)); $t[1] = "'".$t[1]."'" if ($#t == 1 && !($t[1] =~ /^\$/));
skipping to change at line 645 skipping to change at line 632
# check for old usage of PERLDL::PREPROCESS # check for old usage of PERLDL::PREPROCESS
if (defined $PERLDL::PREPROCESS) { if (defined $PERLDL::PREPROCESS) {
preproc_oldwarn() unless $preproc_warned; preproc_oldwarn() unless $preproc_warned;
} }
$|=1; $|=1;
while(1) { while(1) {
eval {process_input()}; eval {process_input()};
if ($@) { if ($@) {
if ($@ =~ /Ctrl-C detected/) { if ($@ =~ /$interrupt_msg/) {
print "Ctrl-C detected\n"; print "$interrupt_msg\n";
next; next;
} else { } else {
print "Unknown error: $@\n exiting...\n"; print "Unknown error: $@\n exiting...\n";
last; last;
} }
} }
} }
##### #####
##### #####
skipping to change at line 686 skipping to change at line 673
{ {
$__code; $__code;
} }
} }
EOD EOD
; ;
%@ = (); # Workaround to prevent spurious loss of $@ in early (pre-5.14 anyway ) versions of perl %@ = (); # Workaround to prevent spurious loss of $@ in early (pre-5.14 anyway ) versions of perl
if( (!$@) and (ref $__coderef eq 'CODE')) { if( (!$@) and (ref $__coderef eq 'CODE')) {
eval { &$__coderef(); die $@ if($@); }; eval { my $sig_action = mksighandle(); &$__coderef(); die $@ if($@); };
} }
if ($@) { if ($@) {
my $mess = $@; my $mess = $@;
# Remove surplus parts # Remove surplus parts
$mess =~ s/^\s*\(in cleanup\)\s+//; # 'cleanup ...' from Usage:... $mess =~ s/^\s*\(in cleanup\)\s+//; # 'cleanup ...' from Usage:...
$mess =~ s/\n\s*\(in cleanup\).*$//; # 'cleanup...'s at end $mess =~ s/\n\s*\(in cleanup\).*$//; # 'cleanup...'s at end
$mess =~ s/\s+at \(eval \d+\) line \d+\.?$//; # at eval ?? line ??. $mess =~ s/\s+at \(eval \d+\) line \d+\.?$//; # at eval ?? line ??.
skipping to change at line 719 skipping to change at line 706
=head1 SYNOPSIS =head1 SYNOPSIS
Use PDL interactively: Use PDL interactively:
bash$ perldl bash$ perldl
pdl> $x = sequence(10) # or any other perl or PDL command pdl> $x = sequence(10) # or any other perl or PDL command
bash$ pdl bash$ pdl
pdl> print "Hello, world!\n"; pdl> print "Hello, world!\n";
pdl> with_time { print +($A->matmult($B))->info, "\n" } for 1..5;
Run a script: Run a script:
bash$ cat > pdlscript bash$ cat > pdlscript
#!/usr/bin/pdl #!/usr/bin/pdl
print "Hello, world!\n"; print "Hello, world!\n";
... ...
=head1 DESCRIPTION =head1 DESCRIPTION
The program B<perldl> is a simple shell (written in perl) for The program B<perldl> is a simple shell (written in perl) for
skipping to change at line 877 skipping to change at line 866
=head2 Terminating commands (Ctrl-C handling) =head2 Terminating commands (Ctrl-C handling)
Commands executed within C<perldl> can be terminated prematurely Commands executed within C<perldl> can be terminated prematurely
using C<Ctrl-C> (or whichever key sequence sends an INT signal using C<Ctrl-C> (or whichever key sequence sends an INT signal
to the process on your terminal). Provided your PDL code does not to the process on your terminal). Provided your PDL code does not
ignore C<sigint>s this should throw you back at the C<perldl> ignore C<sigint>s this should throw you back at the C<perldl>
command prompt: command prompt:
pdl> $result = start_lengthy_computation() pdl> $result = start_lengthy_computation()
<Ctrl-C> <Ctrl-C>
Ctrl-C detected Ctrl-C detected
pdl> pdl>
As of 2.077, this requires L<Sys::SigAction> to be installed (without
that, and before 2.077, for Perl >5.8 it didn't actually interrupt
things).
=head2 Shortcuts and aliases =head2 Shortcuts and aliases
=over =over
=item * =item *
The shell aliases C<p> to be a convenient short form of C<print>, e.g. The shell aliases C<p> to be a convenient short form of C<print>, e.g.
pdl> p ones 5,3 pdl> p ones 5,3
skipping to change at line 934 skipping to change at line 927
L<usage|PDL::Doc::Perldl/usage> and L<sig|PDL::Doc::Perldl/sig>: L<usage|PDL::Doc::Perldl/usage> and L<sig|PDL::Doc::Perldl/sig>:
all words after these commands are used verbatim and not evaluated all words after these commands are used verbatim and not evaluated
by perl. So you can write, e.g., by perl. So you can write, e.g.,
pdl> help help pdl> help help
instead of instead of
pdl> help 'help' pdl> help 'help'
=item *
C<with_time> runs the following code-block, and tells you how long it
took, in milliseconds. Requires L<Time::HiRes>.
pdl> with_time { print +($A->matmult($B))->info, "\n" } for 1..5;
=back =back
=head2 Command-line options =head2 Command-line options
B<perldl> and B<pdl> support several command-line options to adjust the behavior of the B<perldl> and B<pdl> support several command-line options to adjust the behavior of the
session. Most of them are equivalent to commands that can be entered at the B<p dlE<gt>> session. Most of them are equivalent to commands that can be entered at the B<p dlE<gt>>
prompt. They are: prompt. They are:
=over 4 =over 4
 End of changes. 21 change blocks. 
82 lines changed or deleted 84 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)