Created
June 25, 2015 16:03
-
-
Save jmason/b6894bde947e0f013b40 to your computer and use it in GitHub Desktop.
pcalc
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
# | |
# pcalc -- simple perl calculator for desktop arithmetic. | |
use strict; | |
use bytes; | |
if (@ARGV > 0 && $ARGV[0] eq '--filter') { | |
shift; | |
while (<>) { | |
s{\s*([^=]*)=.*?$}{ interpret_embedded_calc($1); }gei; | |
print; | |
} | |
exit; | |
} | |
else { | |
print "pcalc v1.1 by jm.jmason.org -- a simple Perl calculator tool.\n"; | |
print "Type 'help' for help.\n\n"; | |
my $line = join (' ', @ARGV); | |
if ($line) { | |
doline ($line); | |
} | |
else { | |
while (<STDIN>) { | |
doline ($_); | |
} | |
} | |
exit; | |
} | |
sub interpret_embedded_calc { | |
my ($in) = @_; | |
$in =~ s/^\s+//; | |
$in =~ s/\s+$//; | |
$in =~ s/\s+/ /gs; | |
my ($r, $extra) = docalc($in); | |
return "$in = $r"; | |
} | |
sub doline { | |
my ($in) = @_; | |
my ($r, $extra) = docalc($in); | |
if (defined $extra) { | |
print STDOUT "--> $r\t\t[$extra]\n"; | |
} else { | |
print STDOUT "--> $r\n"; | |
} | |
} | |
my $lastline; | |
sub docalc { | |
local($_); | |
$_ = shift; | |
chomp; my $subst = 0; | |
my $r = 0; | |
s/!!/${lastline}/g && $subst++; | |
$lastline = $_; | |
if ($subst) { | |
print "$_\n"; | |
} | |
if (/^help *|^\?/) { | |
&help; | |
} elsif (s/^quit|^exit//) { | |
exit 0; | |
} elsif (s/^(?:date|d) //) { | |
$r = &date_to_dec($_); | |
} elsif (s/^bin //) { | |
$r = &bin_to_dec($_); | |
} elsif (s/^big //) { | |
if (!defined ($r = eval 'use bigint;'.$_.';')) { | |
$@ =~ s/ at \(eval.*$//g; $@ =~ s/\n//g; | |
$r = "'$_': $@"; | |
} | |
} elsif (/\S/) { | |
if (!defined ($r = eval $_.';')) { | |
$@ =~ s/ at \(eval.*$//g; $@ =~ s/\n//g; | |
$r = "'$_': $@"; | |
} | |
} | |
if ($r =~ /^[-0-9\.]/) { | |
if (can_bigint()) { | |
return compute_bigint($r); | |
} else { | |
return compute_basic($r); | |
} | |
} else { | |
return ("\"$r\""); | |
} | |
} | |
sub can_bigint { | |
return eval q{ use bigint; use Math::BigInt; 1; }; | |
} | |
sub compute_basic { | |
my $r = shift; | |
return ($r, sprintf("[hex=0x%x oct=0%o date=%s bin=%s]", | |
$r+0, $r+0, | |
dec_to_date($r), | |
DecToBin($r) | |
)); | |
} | |
sub compute_bigint { | |
my $r = shift; | |
use bigint; | |
use Math::BigInt; | |
my $big = Math::BigInt->new($r+0); | |
my $oct = eval { $big->as_oct(); }; | |
if ($@) { $oct = sprintf "0%o", $r+0; } | |
return ($r, sprintf("[hex=%s oct=%s date=%s bin=%s]", | |
$big->as_hex(), | |
$oct, | |
dec_to_date($r), | |
$big->as_bin() | |
)); | |
} | |
sub bin_to_dec { | |
local ($_) = @_; | |
s/\s//g; if (s/[^01]//g) { | |
warn "warning: non-binary characters ignored in \"$_\"\n"; | |
} | |
my $r; | |
for ($r = 0; /^([10])/; $r *= 2, s/^.//) { | |
$r++ if ($1 eq '1'); | |
} | |
$r/=2; | |
} | |
sub DecToBin { | |
local ($_) = @_; | |
$_ = int ($_) + 0; | |
my $r = ''; my $e = 1; $_ += 0; | |
for ($r = '', $e = 1; $_; $e <<= 1) { | |
if ($_ & $e) { | |
$r = "1$r"; $_ ^= $e; | |
} else { | |
$r = "0$r"; | |
} | |
} | |
$r; | |
} | |
use POSIX qw(strftime); | |
sub dec_to_date { | |
local ($_) = @_; | |
$_ = int ($_) + 0; | |
if ($_ > 1000000000000) { $_ /= 1000; } | |
my $s = strftime ("%a %b %e %H:%M:%S %Y", localtime ($_)); | |
chomp $s; | |
return $s; | |
} | |
sub date_to_dec { | |
my ($date) = @_; | |
eval q{ use Time::ParseDate; }; | |
return parsedate($date, NO_RELATIVE => 1); | |
} | |
sub help { | |
print <<EOHELP; | |
Commands are: | |
bin translate binary to decimal | |
d[ate] datestring translate date to time_t | |
Anything else is interpreted as a perl expression, and the result output. | |
EOHELP | |
} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment