# PaCkAgE DaTaStReAm CSWpm-math-calc-units 1 392 # end of header 07070100b27a5c000081a4000027100000271000000001510fb5a6000002b20000010000010027ffffffffffffffff0000001e00000000CSWpm-math-calc-units/pkginfoWORKDIR_FIRSTMOD=../build-isa-sparcv8plus PERL_MODULE_NAME=Math-Calc-Units OPENCSW_OS_ARCH=sparc OPENCSW_OS_RELEASE=SunOS5.10 OPENCSW_BUNDLE=Math-Calc-Units OPENCSW_REPOSITORY=https://gar.svn.sf.net/svnroot/gar/csw/mgar/pkg/cpan/Math-Calc-Units/trunk@20255 OPENCSW_MODE64=32 OPENCSW_CATALOGNAME=pm_math_calc_units HOTLINE=http://www.opencsw.org/bugtrack/ CLASSES=none PSTAMP=dam@unstable10s-20130204142036 EMAIL=dam@opencsw.org VENDOR=http://search.cpan.org/~sfink/Math-Calc-Units packaged for CSW by Dagobert Michelsen CATEGORY=application VERSION=1.07,REV=2013.02.04 ARCH=all NAME=pm_math_calc_units - Math-Calc-Units: Unit-aware calculator with readable output PKG=CSWpm-math-calc-units 07070100b27a5b000081a4000027100000271000000001510fb5a600000aaa0000010000010027ffffffffffffffff0000001d00000000CSWpm-math-calc-units/pkgmap: 1 392 1 f none /opt/csw/bin/ucalc 0555 root bin 2190 38425 1359981412 1 d none /opt/csw/lib/perl 0755 root bin 1 d none /opt/csw/lib/perl/5.10.1 0755 root bin 1 d none /opt/csw/lib/perl/csw 0755 root bin 1 d none /opt/csw/lib/perl/csw/auto 0755 root bin 1 d none /opt/csw/lib/perl/csw/auto/Math 0755 root bin 1 d none /opt/csw/lib/perl/csw/auto/Math/Calc 0755 root bin 1 d none /opt/csw/lib/perl/csw/auto/Math/Calc/Units 0755 root bin 1 d none /opt/csw/share/doc/pm_math_calc_units 0755 root bin 1 f none /opt/csw/share/doc/pm_math_calc_units/license 0644 root bin 1811 26425 1359984034 1 d none /opt/csw/share/man/man3 0755 root bin 1 f none /opt/csw/share/man/man3/Math::Calc::Units.3perl 0444 root bin 6584 50847 1359981412 1 d none /opt/csw/share/perl 0755 root bin 1 d none /opt/csw/share/perl/csw 0755 root bin 1 d none /opt/csw/share/perl/csw/Math 0755 root bin 1 d none /opt/csw/share/perl/csw/Math/Calc 0755 root bin 1 d none /opt/csw/share/perl/csw/Math/Calc/Units 0755 root bin 1 f none /opt/csw/share/perl/csw/Math/Calc/Units.pm 0444 root bin 4158 14358 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Compute.pm 0444 root bin 4505 57041 1359981412 1 d none /opt/csw/share/perl/csw/Math/Calc/Units/Convert 0755 root bin 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert.pm 0444 root bin 1661 3629 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Base.pm 0444 root bin 6735 10346 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Base2Metric.pm 0444 root bin 1259 28646 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Byte.pm 0444 root bin 1166 25274 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Combo.pm 0444 root bin 1916 22571 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Date.pm 0444 root bin 3201 27543 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Distance.pm 0444 root bin 2852 31948 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Metric.pm 0444 root bin 4455 12736 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Multi.pm 0444 root bin 3359 8295 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Time.pm 0444 root bin 3424 57557 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Grammar.pm 0444 root bin 15271 12038 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Grammar.y 0444 root bin 1228 20107 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Rank.pm 0444 root bin 8146 43370 1359981412 1 i checkpkg_override 113 10856 1359981413 1 i copyright 82 7823 1359984034 1 i cswpm-meta.yml 473 36119 1359984034 1 i depend 128 11494 1359984036 1 i pkginfo 690 58240 1359984038 07070100000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000b00000000TRAILER!!!07070100b27a5c000081a4000027100000271000000001510fb5a6000002b20000010000010027ffffffffffffffff0000000800000000pkginfoWORKDIR_FIRSTMOD=../build-isa-sparcv8plus PERL_MODULE_NAME=Math-Calc-Units OPENCSW_OS_ARCH=sparc OPENCSW_OS_RELEASE=SunOS5.10 OPENCSW_BUNDLE=Math-Calc-Units OPENCSW_REPOSITORY=https://gar.svn.sf.net/svnroot/gar/csw/mgar/pkg/cpan/Math-Calc-Units/trunk@20255 OPENCSW_MODE64=32 OPENCSW_CATALOGNAME=pm_math_calc_units HOTLINE=http://www.opencsw.org/bugtrack/ CLASSES=none PSTAMP=dam@unstable10s-20130204142036 EMAIL=dam@opencsw.org VENDOR=http://search.cpan.org/~sfink/Math-Calc-Units packaged for CSW by Dagobert Michelsen CATEGORY=application VERSION=1.07,REV=2013.02.04 ARCH=all NAME=pm_math_calc_units - Math-Calc-Units: Unit-aware calculator with readable output PKG=CSWpm-math-calc-units 07070100b27a5b000081a4000027100000271000000001510fb5a600000aaa0000010000010027ffffffffffffffff0000000700000000pkgmap: 1 392 1 f none /opt/csw/bin/ucalc 0555 root bin 2190 38425 1359981412 1 d none /opt/csw/lib/perl 0755 root bin 1 d none /opt/csw/lib/perl/5.10.1 0755 root bin 1 d none /opt/csw/lib/perl/csw 0755 root bin 1 d none /opt/csw/lib/perl/csw/auto 0755 root bin 1 d none /opt/csw/lib/perl/csw/auto/Math 0755 root bin 1 d none /opt/csw/lib/perl/csw/auto/Math/Calc 0755 root bin 1 d none /opt/csw/lib/perl/csw/auto/Math/Calc/Units 0755 root bin 1 d none /opt/csw/share/doc/pm_math_calc_units 0755 root bin 1 f none /opt/csw/share/doc/pm_math_calc_units/license 0644 root bin 1811 26425 1359984034 1 d none /opt/csw/share/man/man3 0755 root bin 1 f none /opt/csw/share/man/man3/Math::Calc::Units.3perl 0444 root bin 6584 50847 1359981412 1 d none /opt/csw/share/perl 0755 root bin 1 d none /opt/csw/share/perl/csw 0755 root bin 1 d none /opt/csw/share/perl/csw/Math 0755 root bin 1 d none /opt/csw/share/perl/csw/Math/Calc 0755 root bin 1 d none /opt/csw/share/perl/csw/Math/Calc/Units 0755 root bin 1 f none /opt/csw/share/perl/csw/Math/Calc/Units.pm 0444 root bin 4158 14358 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Compute.pm 0444 root bin 4505 57041 1359981412 1 d none /opt/csw/share/perl/csw/Math/Calc/Units/Convert 0755 root bin 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert.pm 0444 root bin 1661 3629 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Base.pm 0444 root bin 6735 10346 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Base2Metric.pm 0444 root bin 1259 28646 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Byte.pm 0444 root bin 1166 25274 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Combo.pm 0444 root bin 1916 22571 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Date.pm 0444 root bin 3201 27543 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Distance.pm 0444 root bin 2852 31948 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Metric.pm 0444 root bin 4455 12736 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Multi.pm 0444 root bin 3359 8295 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Convert/Time.pm 0444 root bin 3424 57557 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Grammar.pm 0444 root bin 15271 12038 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Grammar.y 0444 root bin 1228 20107 1359981412 1 f none /opt/csw/share/perl/csw/Math/Calc/Units/Rank.pm 0444 root bin 8146 43370 1359981412 1 i checkpkg_override 113 10856 1359981413 1 i copyright 82 7823 1359984034 1 i cswpm-meta.yml 473 36119 1359984034 1 i depend 128 11494 1359984036 1 i pkginfo 690 58240 1359984038 07070100b27a7e000041ed000027100000271000000002510fb5a6000000000000010000010027ffffffffffffffff0000000800000000install07070100b27a81000081a4000027100000271000000001510fb5a2000001d90000010000010027ffffffffffffffff0000001700000000install/cswpm-meta.yml--- #YAML:1.0 name: Math-Calc-Units version: 1.07 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.50 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 07070100b27a7f000081a4000027100000271000000001510fab65000000710000010000010027ffffffffffffffff0000001a00000000install/checkpkg_overrideCSWpm-math-calc-units: surplus-dependency CSWpm-math-calc-units: pkginfo-description-not-starting-with-uppercase 07070100b27a82000081a4000027100000271000000001510fb5a4000000800000010000010027ffffffffffffffff0000000f00000000install/dependP CSWcommon common - common files and dirs for CSW packages P CSWperl perl - A high-level, general-purpose programming language 07070100b27a80000081a4000027100000271000000001510fb5a2000000520000010000010027ffffffffffffffff0000001200000000install/copyrightPlease see /opt/csw/share/doc/pm_math_calc_units/license for license information. 07070100b27a5d000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000000500000000root07070100b27a5e000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000000900000000root/opt07070100b27a5f000041ed000027100000271000000004510fb5a6000000000000010000010027ffffffffffffffff0000000d00000000root/opt/csw07070100b27a62000041ed000027100000271000000005510fb5a6000000000000010000010027ffffffffffffffff0000001300000000root/opt/csw/share07070100b27a66000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000001700000000root/opt/csw/share/man07070100b27a67000041ed000027100000271000000002510fb5a6000000000000010000010027ffffffffffffffff0000001c00000000root/opt/csw/share/man/man307070100b27a6800008124000027100000271000000001510fab64000019b80000010000010027ffffffffffffffff0000003400000000root/opt/csw/share/man/man3/Math::Calc::Units.3perl.\" Automatically generated by Pod::Man 2.22 (Pod::Simple 3.15) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is turned on, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .ie \nF \{\ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . nr % 0 . rr F .\} .el \{\ . de IX .. .\} .\" .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). .\" Fear. Run. Save yourself. No user-serviceable parts. . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds / .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE .\} .rm #[ #] #H #V #F C .\" ======================================================================== .\" .IX Title "Units 3" .TH Units 3 "2009-08-04" "perl v5.10.1" "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" Math::Calc::Units \- Human\-readable unit\-aware calculator .SH "SYNOPSIS" .IX Header "SYNOPSIS" .Vb 1 \& use Math::Calc::Units qw(calc readable convert equal); \& \& print "It will take ".calc("10MB/(384Kbps)")." to download\en"; \& \& my @alternative_descriptions = readable("10MB/(384Kbps)"); \& \& print "A week is ".convert("1 week", "seconds")." long\en"; \& \& if (equal("$rate bytes / sec", "1 MB/sec")) { ... }; .Ve .SH "DESCRIPTION" .IX Header "DESCRIPTION" \&\f(CW\*(C`Math::Calc::Units\*(C'\fR is a simple calculator that keeps track of units. It currently handles combinations of byte sizes and duration only, although adding any other multiplicative types is easy. Any unknown type is treated as a unique user type (with some effort to map English plurals to their singular forms). .PP The primary intended use is via the \f(CW\*(C`ucalc\*(C'\fR script that prints out all of the \*(L"readable\*(R" variants of a value. For example, \f(CW"3 bytes"\fR will only produce \f(CW"3 byte"\fR, but \f(CW"3 byte / sec"\fR produces the original along with \f(CW"180 byte / minute"\fR, \f(CW"10.55 kilobyte / hour"\fR, etc. .PP The \f(CW\*(C`Math::Calc::Units\*(C'\fR interface only provides for string-based computations, which could result in a large loss of precision for some applications. If you need the exact result, you may pass in an extra parameter \f(CW\*(Aqexact\*(Aq\fR to \f(CW\*(C`calc\*(C'\fR or \f(CW\*(C`convert\*(C'\fR, causing them to return a 2\-element list containing the numerical result and a string describing the units of that result: .PP .Vb 1 \& my ($value, $units) = convert("10MB/sec", "GB/day"); .Ve .PP (In scalar context, they just return the numeric value.) .SS "Examples of use" .IX Subsection "Examples of use" .IP "\(bu" 4 Estimate transmission rates (e.g., 10MB at 384 kilobit/sec) .IP "\(bu" 4 Estimate performance characteristics (e.g., disk I/O rates) .IP "\(bu" 4 Figure out how long something will take to complete .PP I tend to work on performance-sensitive code that involves a lot of network and disk traffic, so I wrote this tool after I became very sick of constantly converting KB/sec to GB/day when trying to figure out how long a run is going to take, or what the theoretical maximum performance would be if we were 100% disk bound. Now I can't live without it. .SS "Contraindications" .IX Subsection "Contraindications" If you are just trying to convert from one unit to another, you'll probably be better off with \f(CW\*(C`Math::Units\*(C'\fR or \f(CW\*(C`Convert::Units\*(C'\fR. This module really only makes sense when you're converting to and from human-readable values. .SH "AUTHOR" .IX Header "AUTHOR" Steve Fink .SH "SEE ALSO" .IX Header "SEE ALSO" ucalc, Math::Units, Convert::Units. 07070100b27a63000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000001700000000root/opt/csw/share/doc07070100b27a64000041ed000027100000271000000002510fb5a6000000000000010000010027ffffffffffffffff0000002a00000000root/opt/csw/share/doc/pm_math_calc_units07070100b27a65000081a4000027100000271000000001510fb5a2000007130000010000010027ffffffffffffffff0000003200000000root/opt/csw/share/doc/pm_math_calc_units/licenseCopyright (c) 2001 by Steve A. Fink. All rights reserved. See COPYING for the General Public License and Artistic.html for the Artistic license. You are hereby granted permission to use this software under the terms of either the GPL or the Artistic License. I have the right to change the licensing terms at any time, but if you hide a copy on a floppy in the back of your underwear drawer, then you'll still be able to use it under the terms above because that's just the way things work. (I own the copyright, but I just gave you a license to use this version under the GPL or the Artistic license, and I can't take it back without breaking into your house and digging through your underwear drawer.) You, however, cannot implement an animated paperclip extension and pick a different license to give your modified copy away under, because you don't own the copyright and the GPL doesn't allow that nya nya. That is, until you remember that you can choose to use it under the Artistic License, which does allow that sort of thing, at least for the part you wrote. So go right ahead. ---- GPL boilerplate --- Copyright (C) 2001 Steve A. Fink This program is free software; you can redistribute it and/or modify it under the terms of version 2 of the GNU General Public License as published by the Free Software Foundation. This program 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 this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 07070100b27a69000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000001800000000root/opt/csw/share/perl07070100b27a6a000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000001c00000000root/opt/csw/share/perl/csw07070100b27a6b000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000002100000000root/opt/csw/share/perl/csw/Math07070100b27a6c000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000002600000000root/opt/csw/share/perl/csw/Math/Calc07070100b27a6d00008124000027100000271000000001510fab640000103e0000010000010027ffffffffffffffff0000002f00000000root/opt/csw/share/perl/csw/Math/Calc/Units.pmpackage Math::Calc::Units; use Math::Calc::Units::Compute qw(compute); use Math::Calc::Units::Rank qw(render render_unit choose_juicy_ones); use Math::Calc::Units::Convert; use base 'Exporter'; use vars qw($VERSION @EXPORT_OK); BEGIN { $VERSION = '1.07'; @EXPORT_OK = qw(calc readable convert equal exact); } use strict; # calc : string -> string # calc : string x true -> magnitude x string sub calc ($;$) { my ($expr, $exact) = @_; my $v = compute($expr); return $exact ? ($v->[0], render_unit($v->[1])) : render($v); } # readable : string -> ( string ) sub readable { my $expr = shift; my %options; if (@_ == 1) { $options{verbose} = shift; } else { %options = @_; } my $v = compute($expr); return map { render($_, \%options) } choose_juicy_ones($v, \%options); } # convert : string x string [ x boolean ] -> string sub convert ($$;$) { my ($expr, $units, $exact) = @_; my $v = compute($expr); my $u = compute("# $units"); my $c = Math::Calc::Units::Convert::convert($v, $u->[1]); return $exact ? ($c->[0], render_unit($c->[1])) : render($c); } # equal : string x string -> boolean use constant EPSILON => 1e-12; sub equal { my ($u, $v) = @_; $u = compute($u); $v = compute($v); $v = Math::Calc::Units::Convert::convert($v, $u->[1]); $u = $u->[0]; $v = $v->[0]; return 1 if ($u == 0) && abs($v) < EPSILON; return abs(($u-$v)/$u) < EPSILON; } if (!(caller)) { my $verbose; my %options; if ($ARGV[0] eq '-v') { shift; $options{verbose} = 1; } if ($ARGV[0] eq '-a') { shift; $options{abbreviate} = 1; } print "$_\n" foreach readable($ARGV[0], %options); } =head1 NAME Math::Calc::Units - Human-readable unit-aware calculator =head1 SYNOPSIS use Math::Calc::Units qw(calc readable convert equal); print "It will take ".calc("10MB/(384Kbps)")." to download\n"; my @alternative_descriptions = readable("10MB/(384Kbps)"); print "A week is ".convert("1 week", "seconds")." long\n"; if (equal("$rate bytes / sec", "1 MB/sec")) { ... }; =head1 DESCRIPTION C is a simple calculator that keeps track of units. It currently handles combinations of byte sizes and duration only, although adding any other multiplicative types is easy. Any unknown type is treated as a unique user type (with some effort to map English plurals to their singular forms). The primary intended use is via the C script that prints out all of the "readable" variants of a value. For example, C<"3 bytes"> will only produce C<"3 byte">, but C<"3 byte / sec"> produces the original along with C<"180 byte / minute">, C<"10.55 kilobyte / hour">, etc. The C interface only provides for string-based computations, which could result in a large loss of precision for some applications. If you need the exact result, you may pass in an extra parameter C<'exact'> to C or C, causing them to return a 2-element list containing the numerical result and a string describing the units of that result: my ($value, $units) = convert("10MB/sec", "GB/day"); (In scalar context, they just return the numeric value.) =head2 Examples of use =over 4 =item * Estimate transmission rates (e.g., 10MB at 384 kilobit/sec) =item * Estimate performance characteristics (e.g., disk I/O rates) =item * Figure out how long something will take to complete =back I tend to work on performance-sensitive code that involves a lot of network and disk traffic, so I wrote this tool after I became very sick of constantly converting KB/sec to GB/day when trying to figure out how long a run is going to take, or what the theoretical maximum performance would be if we were 100% disk bound. Now I can't live without it. =head2 Contraindications If you are just trying to convert from one unit to another, you'll probably be better off with C or C. This module really only makes sense when you're converting to and from human-readable values. =head1 AUTHOR Steve Fink =head1 SEE ALSO ucalc, Math::Units, Convert::Units. =cut 1; 07070100b27a6e000041ed000027100000271000000003510fb5a6000000000000010000010027ffffffffffffffff0000002c00000000root/opt/csw/share/perl/csw/Math/Calc/Units07070100b27a7d00008124000027100000271000000001510fab6400001fd20000010000010027ffffffffffffffff0000003400000000root/opt/csw/share/perl/csw/Math/Calc/Units/Rank.pmpackage Math::Calc::Units::Rank; use base 'Exporter'; use vars qw(@EXPORT_OK); BEGIN { @EXPORT_OK = qw(choose_juicy_ones render render_unit); } use Math::Calc::Units::Convert qw(convert canonical); use Math::Calc::Units::Convert::Multi qw(variants major_variants major_pref pref_score range_score get_class); use strict; # choose_juicy_ones : value -> ( value ) # # Pick the best-sounding units for the given value, and compute the # resulting magnitude and score. The total number returned is based on # a magical formula that examines the rates of decay of the scores. # sub choose_juicy_ones { my ($v, $options) = @_; # Collect the variants of the value, together with their scores. my @variants = rank_variants($v, $options); # ( < {old=>new}, score > ) # Remove duplicates my %variants; # To remove duplicates: { id => [ {old=>new}, score ] } for my $variant (@variants) { my $id = join(";;", values %{ $variant->[0] }); $variants{$id} = $variant; } my @options; for my $variant (values %variants) { my ($map, $score) = @$variant; my %copy; my ($magnitude, $units) = @$v; while (my ($unit, $count) = each %$units) { $copy{$map->{$unit}} = $count; } push @options, [ $score, convert($v, \%copy) ]; } # Pick up to five of the highest scores. If any score is less than # 1/10 of the previous score, or 1/25 of the highest score, then # don't bother returning it (or anything worse than it.) my @juicy; my $first; my $prev; foreach (sort { $b->[0] <=> $a->[0] } @options) { my ($score, $val) = @$_; last if (defined $prev && ($prev / $score) > 8); last if (defined $first && ($first / $score) > 25); push @juicy, $val; $first = $score unless defined $first; $prev = $score; last if @juicy == 5; } return @juicy; } # rank_variants : -> ( < map, score > ) # where map : {original unit => new unit} # sub rank_variants { my ($v, $options) = @_; $v = canonical($v); my ($mag, $count) = @$v; my @rangeable = grep { $count->{$_} > 0 } keys %$count; if (@rangeable == 0) { @rangeable = keys %$count; } return rank_power_variants($mag, \@rangeable, $count, $options); } sub choose_major { my (@possibilities) = @_; my @majors = map { [ major_pref($_), $_ ] } @possibilities; return (sort { $a->[0] <=> $b->[0] } @majors)[-1]->[1]; } # rank_power_variants : value x [unit] x {unit=>power} x options -> # ( ) # # $top is the set of units that should be range checked. # sub rank_power_variants { my ($mag, $top, $power, $options) = @_; # Recursive case: we have multiple units left, so pick one to be # the "major" unit and select the best combination of the other # units for each major variant on the major unit. if (keys %$power > 1) { # Choose the major unit class (this will return the best # result for each of the major variants) my $major = choose_major(keys %$power); my $majorClass = get_class($major); my %powerless = %$power; delete $powerless{$major}; my @ranked; # ( ) # Try every combination of each major variant and the other units foreach my $variant (major_variants($major, $options)) { my $mult = $majorClass->simple_convert($variant, $major); my $cval = $mag / $mult ** $power->{$major}; print "\n --- for $variant ---\n" if $options->{verbose}; my @r = rank_power_variants($cval, $top, \%powerless, $options); next if @r == 0; my $best = $r[0]; $best->[0]->{$major} = $variant; # Augment map # Replace score with major pref $best->[1] = pref_score($variant); push @ranked, $best; } return @ranked; } # Base case: have a single unit left. Go through all possible # variants of that unit. if (keys %$power == 0) { # Special case: we don't have any units at all return [ {}, 1 ]; } my $unit = (keys %$power)[0]; $power = $power->{$unit}; # Now it's just the power of this unit my $class = get_class($unit); my (undef, $canon) = $class->to_canonical($unit); my $mult = $class->simple_convert($unit, $canon); $mag *= $mult ** $power; my @choices; my @subtop = grep { $_ ne $canon } @$top; my $add_variant = (@subtop == @$top); # Flag: add $variant to @$top? foreach my $variant (variants($canon)) { # Convert from $canon to $variant # Input: 4000 / sec ; (canon=sec) # 1 ms -> .001 sec ; (variant=ms) # 4000 / (.001 ** -1) = 4 / ms my $mult = $class->simple_convert($variant, $canon); my $minimag = $mag / $mult ** $power; my @vtop = @subtop; push @vtop, $variant if $add_variant; my $score = score($minimag, $variant, \@vtop); printf "($mag $unit) score %.6f:\t $minimag $variant\n", $score if $options->{verbose}; push @choices, [ $score, $variant ]; } @choices = sort { $b->[0] <=> $a->[0] } @choices; return () if @choices == 0; return map { [ {$unit => $_->[1]}, $_->[0] ] } @choices; } # Return a string representing a given set of units. The input is a # map from unit names to their powers (eg lightyears/sec/sec would be # represented as { lightyears => 1, sec => -2 }); the output is a # corresponding string such as "lightyears / sec**2". sub render_unit { my ($units, $options) = @_; # Positive powers just get appended together with spaces between # them. my $str = ''; while (my ($name, $power) = each %$units) { if ($power > 0) { $str .= get_class($name)->render_unit($name, $power, $options); $str .= " "; } } chop($str); # Negative powers will be placed after a "/" character, because # they're in the denominator. my $botstr = ''; while (my ($name, $power) = each %$units) { if ($power < 0) { $botstr .= get_class($name)->render_unit($name, -$power, $options); $botstr .= " "; } } chop($botstr); # Combine the numerator and denominator appropriately. if ($botstr eq '') { return $str; } elsif ($botstr =~ /\s/) { return "$str / ($botstr)"; } else { return "$str / $botstr"; } } # render : -> string sub render { my ($v, $options) = @_; my ($mag, $units) = @$v; # No units if (keys %$units == 0) { # Special-case percentages my $str = sprintf("%.4g", $mag); if (($mag < 1) && ($mag >= 0.01)) { if ($options->{abbreviate}) { $str .= sprintf(" = %.4g percent", 100 * $mag); } else { $str .= sprintf(" = %.4g%%", 100 * $mag); } } return $str; } my @top; my @bottom; while (my ($name, $power) = each %$units) { if ($power > 0) { push @top, $name; } else { push @bottom, $name; } } my $str; if (@top == 1) { my ($name) = @top; $str = get_class($name)->render($mag, $name, $units->{$name}, $options); $str .= " "; } else { $str = sprintf("%.4g ", $mag); foreach my $name (@top) { $str .= get_class($name)->render_unit($name, $units->{$name}, $options); $str .= " "; } } if (@bottom > 0) { my $botstr; foreach my $name (@bottom) { $botstr .= get_class($name)->render_unit($name, -$units->{$name}, $options); $botstr .= " "; } chop($botstr); if (@bottom > 1) { $str .= "/ ($botstr) "; } else { $str .= "/ $botstr "; } } chop($str); return $str; } # max_range_score : amount x [ unit ] -> score # # Takes max score for listed units. # sub max_range_score { my ($mag, $units) = @_; my $score = 0; foreach my $name (@$units) { my $uscore = range_score($mag, $name); $score = $uscore if $score < $uscore; } return $score; } # Arguments: # $mag - The magnitude of the value (in the given unit) # $unit - The unit to use to figure out what sounds best # $top - ...I'll get back to you... sub score { my ($mag, $unit, $top) = @_; my @rangeable = @$top ? @$top : ($unit); my $pref = pref_score($unit); my $range_score = max_range_score($mag, \@rangeable); return $pref * $range_score; } 1; 07070100b27a71000041ed000027100000271000000002510fb5a6000000000000010000010027ffffffffffffffff0000003400000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert07070100b27a7a00008124000027100000271000000001510fab6400000d600000010000010027ffffffffffffffff0000003c00000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Time.pmpackage Math::Calc::Units::Convert::Time; use base 'Math::Calc::Units::Convert::Metric'; use strict; use vars qw(%units %pref %ranges %total_unit_map); %units = ( minute => [ 60, 'sec' ], hour => [ 60, 'minute' ], day => [ 24, 'hour' ], week => [ 7, 'day' ], year => [ 365, 'day' ], # Inexact unit... ugh... ); %pref = ( default => 1, hour => 0.8, day => 0.8, week => 0.4, minute => 0.9, year => 0.9, ); %ranges = ( default => [ 1, 300 ], millisec => [ 1, 999 ], sec => [ 1, 200 ], minute => [ 2, 100 ], hour => [ 1, 80 ], day => [ 1, 500 ], week => [ 1, 4 ], year => [ 1, undef ], ); sub major_pref { return 2; } sub major_variants { my ($self) = @_; return grep { ($_ ne 'default') && ($_ ne 'week') } keys %ranges; } # Return a list of the variants of the canonical unit of time: 'sec' sub variants { my ($self, $base) = @_; return 'sec', (keys %units), map { "${_}sec" } $self->get_prefixes({ small => 1 }); } sub unit_map { my ($self) = @_; if (keys %total_unit_map == 0) { %total_unit_map = (%{$self->SUPER::unit_map()}, %units); } return \%total_unit_map; } sub canonical_unit { return 'sec'; } sub abbreviated_canonical_unit { return 's'; } # demetric : string => [ mult, base ] # # Must override here to avoid megahours or milliweeks # sub demetric { my ($self, $string) = @_; if (my $prefix = $self->get_prefix($string)) { my $tail = substr($string, length($prefix)); if ($tail =~ /^sec(ond)?s?$/) { return ($self->get_metric($prefix), "sec"); } return; # Should this fail, or assume it's a non-metric unit? } else { return (1, $string); } } # simple_convert : unitName x unitName -> multiplier # # Does not allow msec (only millisec or ms) # sub simple_convert { my ($self, $from, $to) = @_; # sec, secs, second, seconds $from = "sec" if $from =~ /^sec(ond)?s?$/i; $from = "minute" if $from =~ /^min(ute)?s?$/i; if (my $easy = $self->SUPER::simple_convert($from, $to)) { return $easy; } # ms == millisec if ($from =~ /^(.)s$/) { my ($expansion) = $self->expand($1); return $self->simple_convert($expansion . "sec", $to); } return; # Failed } ############################################################################## sub preference { my ($self, $v) = @_; my ($val, $unit) = @$v; my $base = lc(($self->demetric($unit))[1]); my $pref = $pref{$base} || $pref{default}; return $pref * $self->prefix_pref(substr($unit, 0, -length($base))); } sub get_ranges { return \%ranges; } sub get_prefs { return \%pref; } my @BREAKDOWN = qw(year week day hour minute sec ms us ns ps); sub render { my ($self, $val, $name, $power, $options) = @_; my $full_name = $name; if ($options->{abbreviate}) { if ($name =~ /(\w+)sec/) { my $prefix = $1; my $mabbrev = $self->metric_abbreviation($prefix); $name = $mabbrev . "s" unless $mabbrev eq $prefix; } } my $basic = $self->SUPER::render($val, $name, $power, $options); return $basic if $power != 1; $val *= $self->simple_convert($full_name, 'sec'); my @spread = $self->spread($val, 'sec', $name, \@BREAKDOWN); my $spread = join(" ", map { "$_->[0] $_->[1]" } @spread); return "($basic = $spread)" if @spread > 1; return $basic; } 1; 07070100b27a7600008124000027100000271000000001510fab6400000c810000010000010027ffffffffffffffff0000003c00000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Date.pmpackage Math::Calc::Units::Convert::Date; use base 'Math::Calc::Units::Convert::Base'; use Time::Local qw(timegm); use strict; use vars qw(%units %pref %ranges %total_unit_map); my $min_nice_time = timegm(0, 0, 0, 1, 0, 1975-1900); my $max_nice_time = timegm(0, 0, 0, 1, 0, 2030-1900); %units = (); %pref = ( default => 1 ); %ranges = ( timestamp => [ $min_nice_time, $max_nice_time ] ); sub major_pref { return 2; } # sub major_variants {} # sub variants {} sub canonical_unit { return 'timestamp'; } sub unit_map { my ($self) = @_; if (keys %total_unit_map == 0) { %total_unit_map = (%{$self->SUPER::unit_map()}, %units); } return \%total_unit_map; } sub get_ranges { return \%ranges; } sub get_prefs { return \%pref; } use vars qw(@MonthNames); BEGIN { @MonthNames = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); } sub construct { my ($self, $constructor, $args) = @_; # Allow timestamp(1000347142) or timestamp() for the current time if ($constructor eq 'timestamp') { $args = time if $args eq ''; return [ $args, { 'timestamp' => 1 } ]; } return unless $constructor eq 'date'; # Accept a very limited range of formats. # Always assume GMT if not given. Currently, do not handle timezones. $args =~ s/\s+GMT\s+$//; my ($Mon, $d, $y, $h, $m, $s, $tz, $M); $tz = 'GMT'; # Format 1: [Weekday] Mon DD HH:MM:SS [Timezone] YYYY # (as returned by gmtime and the 'date' command) # The weekday is ignored if given. The timezone is currently ignored. if ($args =~ /^((?:\w\w\w\s+)?) (\w\w\w)\s* (\d+)\s+ (\d+):(\d+)[:.](\d+)\s+ (\w+)?\s* (\d\d\d\d)$/x) { (undef, $Mon, $d, $h, $m, $s, $tz, $y) = ($1, $2, $3, $4, $5, $6, $7, $8); # Format 2: Mon DD YYYY } elsif ($args =~ /^(\w\w\w)[\s-]* (\d+)[,\s-]+ (\d\d\d\d)$/x) { ($Mon, $d, $y) = ($1, $2, $3); # Format 3: YYYY-MM-DD HH:MM:SS } elsif ($args =~ /^(\d\d\d\d)-(\d+)-(\d+)\s+ (\d+):(\d+)[:.](\d+)$/x) { ($y, $M, $d, $h, $m, $s) = ($1, $2, $3, $4, $5, $6); $M--; # Format 4: YYYY-MM-DD } elsif ($args =~ /^(\d\d\d\d)-(\d+)-(\d+)$/) { ($y, $M, $d) = ($1, $2, $3); $M--; } else { die "Unparseable date string '$args'"; } $h ||= 0; $m ||= 0; $s ||= 0; if (defined $Mon) { $M = 0; foreach (@MonthNames) { last if lc($_) eq lc($Mon); $M++; } die "Unparseable month '$Mon'" if $M > 11; } if (defined($tz) && $tz ne 'GMT') { warn "Timezones not supported. Assuming GMT.\n"; } my $timestamp = timegm($s, $m, $h, $d, $M, $y-1900); die "Date '$args' is out of range" if $timestamp == -1; return [ $timestamp, { 'timestamp' => 1 } ]; } sub render { my ($self, $mag, $name, $power) = @_; return "\@$mag" if $power != 1; return "\@$mag" if $mag < $min_nice_time; return "\@$mag" if $mag > $max_nice_time; return gmtime($mag) . " (\@$mag)"; } 1; 07070100b27a7800008124000027100000271000000001510fab64000011670000010000010027ffffffffffffffff0000003e00000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Metric.pmpackage Math::Calc::Units::Convert::Metric; use base 'Math::Calc::Units::Convert::Base'; use strict; use vars qw(%niceSmallMetric %metric %pref %abbrev %reverse_abbrev $metric_prefix_test); %niceSmallMetric = ( milli => 1e-3, micro => 1e-6, nano => 1e-9, pico => 1e-12, femto => 1e-15, ); %metric = ( kilo => 1e3, mega => 1e6, giga => 1e9, tera => 1e12, peta => 1e15, exa => 1e18, centi => 1e-2, %niceSmallMetric, ); %pref = ( unit => 1.0, kilo => 0.8, mega => 0.8, giga => 0.8, tera => 0.7, peta => 0.6, exa => 0.3, centi => 0.1, milli => 0.8, micro => 0.8, nano => 0.6, pico => 0.4, femto => 0.3, ); %abbrev = ( k => 'kilo', M => 'mega', G => 'giga', T => 'tera', P => 'peta', E => 'exa', c => 'centi', m => 'milli', u => 'micro', n => 'nano', p => 'pico', f => 'femto', ); %reverse_abbrev = reverse %abbrev; # Cannot use the above tables directly because this class must be # overridable. So the following three methods (get_metric, # get_abbrev, and get_prefix) are the only things that are specific to # this class. All other methods can be used unchanged in subclasses. sub pref_score { my ($self, $unitName) = @_; my $prefix = $self->get_prefix($unitName); $unitName = substr($unitName, length($prefix || "")); my $prefix_pref = defined($prefix) ? $self->prefix_pref($prefix) : 1; return $prefix_pref * $self->SUPER::pref_score($unitName); } sub get_metric { my ($self, $what) = @_; return $metric{$what}; } sub get_abbrev { my ($self, $what) = @_; return $abbrev{$what}; } $metric_prefix_test = qr/^(${\join("|",keys %metric)})/i; sub get_prefix { my ($self, $what) = @_; if ($what =~ $metric_prefix_test) { return $1; } else { return; } } sub get_prefixes { my ($self, $options) = @_; if ($options->{small}) { return grep { $metric{$_} < 1 } keys %metric; } else { return keys %metric; } } sub get_abbrev_prefix { my ($self, $what) = @_; my $prefix = substr($what, 0, 1); if ($abbrev{$prefix} || $abbrev{lc($prefix)}) { return $prefix; } else { return; } } sub variants { my ($self, $base) = @_; my @main = $self->SUPER::variants($base); my @variants; for my $u (@main) { push @variants, $u, map { "$_$u" } $self->get_prefixes(); } return @variants; } sub prefix_pref { my ($self, $prefix) = @_; return $pref{lc($prefix)} || $pref{unit}; } # demetric : string => mult x base # # (pronounced de-metric, not demmetric or deme trick) # sub demetric { my ($self, $string) = @_; if (my $prefix = $self->get_prefix($string)) { my $base = substr($string, length($prefix)); return ($self->get_metric($prefix), $base); } else { return (1, $string); } } # expand : char => ( prefix ) # sub expand { my ($self, $char) = @_; my @expansions; my ($exact, $lower); if ($exact = $self->get_abbrev($char)) { push @expansions, $exact; } elsif (($char ne lc($char)) && ($lower = $self->get_abbrev(lc($char)))) { push @expansions, $lower; } return @expansions; } # simple_convert : unitName x unitName -> multiple:number # # A little weird, because it allows centimegamilliwatts # # Example: # megadouble -> millisingle # # (mult_from, base_from) is (1_000_000, double) # (mult_to, base_to) is (.001, single) # submult is 2 (from converting double -> single) # # return submult * (mult_from / mult_to) = 2_000_000_000 # sub simple_convert { my ($self, $from, $to) = @_; my ($mult_from, $base_from) = $self->demetric($from) or return; my ($mult_to, $base_to) = $self->demetric($to) or return; my $submult = $self->SUPER::simple_convert($base_from, $base_to); return if ! defined $submult; return $submult * ($mult_from / $mult_to); } sub metric_abbreviation { my ($self, $prefix) = @_; return $reverse_abbrev{$prefix} || $prefix; } sub render { my ($self, $val, $name, $power, $options) = @_; if ($options->{abbreviate}) { my $stem = $self->canonical_unit; if ($name =~ /(\w+)\Q$stem\E$/) { my $prefix = $reverse_abbrev{$1}; if (defined($prefix)) { $name = $prefix . $self->abbreviated_canonical_unit; } } } return $self->SUPER::render($val, $name, $power, $options); } 1; 07070100b27a7700008124000027100000271000000001510fab6400000b240000010000010027ffffffffffffffff0000004000000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Distance.pmpackage Math::Calc::Units::Convert::Distance; use base 'Math::Calc::Units::Convert::Metric'; use strict; my %total_unit_map; my %ranges = ( default => [ 1, 999 ] ); my %distance_units = ( inch => [ 2.54, 'centimeter' ], foot => [ 12, 'inch' ], yard => [ 3, 'foot' ], mile => [ 5280, 'foot' ], ); my %distance_pref = ( meter => 1.1, inch => 0.7, foot => 0.9, yard => 0, mile => 1.0, ); my %aliases = ( 'feet' => 'foot', ); # Perform all math in terms of meters sub canonical_unit { return 'meter'; } # Metric.pm uses this to construct unit names sub abbreviated_canonical_unit { return 'm'; } # Preference for this class's canonical unit to be the "major" unit # used. The major unit is the one that determines the range of values # to use for computing the overall preference. For example, if you # have 240000 meters/day, you would want to pick "240km/hour", which # is based on the number "240" being a decent one to use for meters. # If you had instead chosen 'hour' as the major unit, then you # wouldn't like using 240 because 240 hours should really be described # as 10 days. # # Note that the above example is not realistic, because the only units # that are eligible for being chosen as the major unit are the ones in # the numerator. So major_pref() is really only used for something # like "square meter seconds", where you want to choose between # "meter" and "second". sub major_pref { return 1; } sub major_variants { my ($self) = @_; return $self->variants('meter'); } sub get_ranges { return \%ranges; } # Return the relative preference of different units. Meters are # preferred over miles, miles over feet. sub get_prefs { return \%distance_pref; } sub singular { my ($self, $unit) = @_; $unit = $self->SUPER::singular($unit); return $aliases{$unit} || $unit; } sub unit_map { my ($self) = @_; if (keys %total_unit_map == 0) { %total_unit_map = (%{$self->SUPER::unit_map()}, %distance_units); } return \%total_unit_map; } # simple_convert : unitName x unitName -> multiplier # sub simple_convert { my ($self, $from, $to) = @_; # 'm', 'meter', or 'meters' return 1 if $from =~ /^m(eter(s?))?$/i; if (my $easy = $self->SUPER::simple_convert($from, $to)) { return $easy; } # km == kilometer if ($from =~ /^(.)m(eter(s?))?$/i) { if (my ($prefix) = $self->expand($1)) { return $self->simple_convert($prefix . "meter", $to); } } return; # Failed } # Override Metric::variants because only meters should be given metric # prefixes, not inches, feet, etc. sub variants { my ($self, $base) = @_; my $canon = $self->canonical_unit(); return ($base, keys %{ $self->unit_map() }, map { "$_$canon" } $self->get_prefixes()); } 1; 07070100b27a7400008124000027100000271000000001510fab640000048e0000010000010027ffffffffffffffff0000003c00000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Byte.pmpackage Math::Calc::Units::Convert::Byte; use base 'Math::Calc::Units::Convert::Base2Metric'; use strict; my %units = ( bit => [ 1/8, 'byte' ] ); my %pref = ( bit => 0.1, default => 1 ); my %ranges = ( default => [ 1, 999 ] ); my %total_unit_map; sub major_pref { return 1; } sub major_variants { my ($self) = @_; return $self->variants('byte'); } sub get_ranges { return \%ranges; } sub get_prefs { return \%pref; } sub unit_map { my ($self) = @_; if (keys %total_unit_map == 0) { %total_unit_map = (%{$self->SUPER::unit_map()}, %units); } return \%total_unit_map; } sub canonical_unit { return 'byte'; } sub abbreviated_canonical_unit { return 'B'; } # simple_convert : unitName x unitName -> multiplier # sub simple_convert { my ($self, $from, $to) = @_; # 'b', 'byte', or 'bytes' return 1 if $from =~ /^b(yte(s?))?$/i; if (my $easy = $self->SUPER::simple_convert($from, $to)) { return $easy; } # mb == megabyte if ($from =~ /^(.)b(yte(s?))?$/i) { if (my ($prefix) = $self->expand($1)) { return $self->simple_convert($prefix . "byte", $to); } } return; # Failed } 1; 07070100b27a7500008124000027100000271000000001510fab640000077c0000010000010027ffffffffffffffff0000003d00000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Combo.pmpackage Math::Calc::Units::Convert::Combo; use base 'Math::Calc::Units::Convert::Base2Metric'; use strict; use vars qw(%units %metric_units %prefixable_metric_units %total_unit_map); use vars qw(%ranges %pref); %units = ( ); %metric_units = ( ); %prefixable_metric_units = ( bps => [ 1, { bit => 1, sec => -1 } ] ); %ranges = ( default => [ 1, 999 ] ); %pref = ( default => 1 ); sub canonical_unit { return; } sub unit_map { my ($self) = @_; if (keys %total_unit_map == 0) { %total_unit_map = (%{$self->SUPER::unit_map()}, %units, %metric_units, %prefixable_metric_units); } return \%total_unit_map; } # Singular("Mbps") is Mbps, not Mbp sub singular { my ($self, $unit) = @_; return $self->SUPER::singular($unit) unless $unit =~ /bps$/; return $unit; } # demetric : string => mult x base # sub demetric { my ($self, $string) = @_; if (my $prefix = $self->get_prefix($string)) { my $tail = lc($self->singular(substr($string, length($prefix)))); if ($metric_units{$tail}) { return ($self->get_metric($prefix), $tail); } } elsif (my $abbrev = $self->get_abbrev_prefix($string)) { my $tail = lc($self->singular(substr($string, length($abbrev)))); if ($prefixable_metric_units{$tail}) { my $prefix = $self->get_abbrev($abbrev); return ($self->get_metric($prefix), $tail); } } return (1, $string); } # to_canonical : unitName -> amount x unitName # sub to_canonical { return; } sub lookup_compound { my ($self, $unitName) = @_; foreach (keys %units, keys %metric_units, keys %prefixable_metric_units) { if (my $mult = $self->simple_convert($unitName, $_)) { my $u = $units{$_} || $metric_units{$_} || $prefixable_metric_units{$_}; return [ $mult * $u->[0], $u->[1] ]; } } return; } sub get_ranges { return \%ranges; } sub get_prefs { return \%pref; } 1; 07070100b27a7300008124000027100000271000000001510fab64000004eb0000010000010027ffffffffffffffff0000004300000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Base2Metric.pmpackage Math::Calc::Units::Convert::Base2Metric; use base 'Math::Calc::Units::Convert::Metric'; # Overrides use strict; use vars qw(%metric_base2 %abbrev $metric_prefix_test %pref); %metric_base2 = ( kilo => 2**10, mega => 2**20, giga => 2**30, tera => 2**40, peta => 2**50, exa => 2**60, ); # No nanobytes, sorry %abbrev = ( k => 'kilo', m => 'mega', g => 'giga', t => 'tera', p => 'peta', e => 'exa', ); %pref = ( unit => 1.0, kilo => 0.8, mega => 0.8, giga => 0.8, tera => 0.7, peta => 0.6, exa => 0.3, ); sub get_metric { my ($self, $what) = @_; return $metric_base2{$what}; } sub get_abbrev { my ($self, $what) = @_; return $abbrev{$what} || $abbrev{lc($what)}; } $metric_prefix_test = qr/^(${\join("|",keys %metric_base2)})/i; sub get_prefix { my ($self, $what) = @_; if ($what =~ $metric_prefix_test) { return $1; } else { return; } } sub prefix_pref { my ($self, $prefix) = @_; return $pref{lc($prefix)} || $pref{unit}; } sub get_prefixes { return keys %metric_base2; } # Unnecessary efficiency hack: don't bother checking both upper & lower case sub expand { my ($self, $char) = @_; return $self->get_abbrev($char); } 1; 07070100b27a7900008124000027100000271000000001510fab6400000d1f0000010000010027ffffffffffffffff0000003d00000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Multi.pmpackage Math::Calc::Units::Convert::Multi; use base 'Exporter'; use vars qw(@EXPORT_OK); BEGIN { @EXPORT_OK = qw(to_canonical simple_convert singular variants major_variants major_pref range_score pref_score get_class construct); }; require Math::Calc::Units::Convert::Time; require Math::Calc::Units::Convert::Byte; require Math::Calc::Units::Convert::Date; require Math::Calc::Units::Convert::Distance; require Math::Calc::Units::Convert::Combo; use strict; use vars qw(@UnitClasses); @UnitClasses = qw(Math::Calc::Units::Convert::Time Math::Calc::Units::Convert::Byte Math::Calc::Units::Convert::Date Math::Calc::Units::Convert::Distance Math::Calc::Units::Convert::Combo); # to_canonical : unit -> value # sub to_canonical { my ($unit) = @_; my $val = 1; my %newUnit; while (my ($unitName, $power) = each %$unit) { my ($mult, $canon) = name_to_canonical($unitName); $val *= $mult ** $power; if (ref $canon) { # Uh oh, it was a combination of basic types my $c = to_canonical($canon); $val *= $c->[0] ** $power; while (my ($name, $subPower) = each %{ $c->[1] }) { if (($newUnit{$name} += $subPower * $power) == 0) { delete $newUnit{$name}; } } } else { if (($newUnit{$canon} += $power) == 0) { delete $newUnit{$canon}; } } } return [ $val, \%newUnit ]; } # name_to_canonical : unitName -> value x baseUnit # # Memoizing this doubles the speed of the test suite. # my %CANON_CACHE; sub name_to_canonical { my $unitName = shift; $CANON_CACHE{$unitName} ||= [ _name_to_canonical($unitName) ]; return @{ $CANON_CACHE{$unitName} }; } sub _name_to_canonical { my ($unitName) = @_; # First, check for compound units if (my $v = Math::Calc::Units::Convert::Combo->lookup_compound($unitName)) { return @$v; } foreach my $uclass (@UnitClasses) { if (my ($val, $base) = $uclass->to_canonical($unitName)) { return ($val, $base); } } return Math::Calc::Units::Convert::Base->to_canonical($unitName); } sub get_class { my ($unitName) = @_; my (undef, $canon) = name_to_canonical($unitName); foreach my $uclass (@UnitClasses) { my $canon_unit = $uclass->canonical_unit(); next if ! defined $canon_unit; return $uclass if $canon_unit eq $canon; } return 'Math::Calc::Units::Convert::Base'; } sub simple_convert { my ($u, $v) = @_; foreach my $uclass (@UnitClasses) { my $c; return $c if $c = $uclass->simple_convert($u, $v); } return; } sub singular { my ($unitName) = @_; return get_class($unitName)->singular($unitName); } sub variants { my ($base) = @_; return get_class($base)->variants($base); } sub major_variants { my ($base) = @_; return get_class($base)->major_variants($base); } sub major_pref { my ($base) = @_; return get_class($base)->major_pref($base); } sub range_score { my ($val, $unitName) = @_; die if ref $unitName; return get_class($unitName)->range_score($val, $unitName); } sub pref_score { my ($unitName) = @_; die if ref $unitName; return get_class($unitName)->pref_score($unitName); } sub construct { my ($constructor, $args) = @_; foreach my $uclass (@UnitClasses) { my $c; return $c if $c = $uclass->construct($constructor, $args); } return; } 1; 07070100b27a7200008124000027100000271000000001510fab6400001a4f0000010000010027ffffffffffffffff0000003c00000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert/Base.pmpackage Math::Calc::Units::Convert::Base; use strict; sub major_pref { return 0; } # major_variants :void -> ( unit name ) # # Return the set of prefix-free variants of the class that you might # want to use as a final result. So for time, this would return # "second" and "year" but not "millisecond" or "gigayear". # # Only this base class will ever use the unit passed in, and that's # because this base class is used for unknown units. Subclasses should # return a list of variants regardless of what is passed as $unit. # sub major_variants { my ($self, $unit) = @_; return $unit; } # singular : unitName -> unitName # # Convert a possibly pluralized unit name to the uninflected singular # form of the same name. # # Example: inches -> inch # Example: inch -> inch # # I suppose I ought to optionally allow Lingu::EN::Inflect or whatever # it's called. # sub singular { my $self = shift; local $_ = shift; return $_ unless /s$/; return $1 if /^(.*[^e])s$/; # doesn't end in es => just chop off the s return $1 if /^(.*(ch|sh))es$/; # eg inches -> inch return $1 if /^(.*[aeiou][^aeiou]e)s$/; # scales -> scale chop; return $_; # Chop off the s } sub unit_map { return {}; } sub variants { my ($self, $base) = @_; my $map = $self->unit_map(); return ($base, keys %$map); } # same : unit x unit -> boolean # # Returns whether the two units match, where a unit is a string (eg # "week") and a power. So "days" and "toothpicks" are not the same, # nor are feet and square feet. sub same { my ($self, $u, $v) = @_; return 0 if keys %$u != keys %$v; while (my ($name, $power) = each %$u) { return 0 if ! exists $v->{$name}; return 0 if $v->{$name} != $power; } return 1; } # simple_convert : unitName x unitName -> multiplier # # Second unit name must be canonical. # sub simple_convert { my ($self, $from, $to) = @_; return 1 if $from eq $to; my $map = $self->unit_map(); my $w = $map->{$from} || $map->{lc($from)}; if (! $w) { $from = $self->singular($from); $w = $map->{$from} || $map->{lc($from)}; } return if ! $w; # Failed # We might have only gotten one step closer (hour -> minute -> sec) if ($w->[1] ne $to) { my $submult = $self->simple_convert($w->[1], $to); return if ! defined $submult; return $w->[0] * $submult; } else { return $w->[0]; } } # to_canonical : unitName -> amount x unitName # # Convert the given unit to the canonical unit for this class, along # with a conversion factor. # sub to_canonical { my ($self, $unitName) = @_; my $canon = $self->canonical_unit(); if ($canon) { my $mult = $self->simple_convert($unitName, $canon); return if ! defined $mult; return ($mult, $canon); } else { return (1, $self->singular($unitName)); } } # canonical_unit : void -> unit name # # Return the canonical unit for this class. # sub canonical_unit { return; } sub abbreviated_canonical_unit { my ($self) = @_; return $self->canonical_unit; } #################### RANKING, SCORING, DISPLAYING ################## # spread : magnitude x base unit x units to spread over # -> ( ) # # @$units MUST BE SORTED, LARGER UNITS FIRST! # my $THRESHOLD = 0.01; sub spread { my ($self, $mag, $base, $start, $units) = @_; die if $mag < 0; # Must be given a positive value! return [ 0, $base ] if $mag == 0; my $orig = $mag; my @desc; my $started = 0; foreach my $unit (@$units) { $started = 1 if $unit eq $start; next unless $started; last if ($mag / $orig) < $THRESHOLD; my $mult = $self->simple_convert($unit, $base); my $n = int($mag / $mult); next if $n == 0; $mag -= $n * $mult; push @desc, [ $n, $unit ]; } return @desc; } # range_score : amount x unitName -> score # # Returns 1 if the value is in range for the unit, 0.1 if the value is # infinitely close to being in range, and decaying to 0.001 as the # value approaches infinitely far away from the range. # # For the outside of range values, I convert to log space (so 1/400 is # just as far away from 1 as 400 is). I then treat the allowed range # as a one standard deviation wide segment of a normal distribution, # and use appropriate modifiers to make the result range from 0.001 to # 0.1. # # The above formula was carefully chosen from thousands of # possibilities, by picking things at random and scribbling them down # on a piece of paper, then pouring sparkling apple cider all over and # using the one that was still readable. # # Ok, not really. Just pretend that I went to that much trouble. # sub range_score { my ($self, $val, $unitName) = @_; my $ranges = $self->get_ranges(); my $range = $ranges->{$unitName} || $ranges->{default}; # Return 1 if it's in range if ($val >= $range->[0]) { if (! defined $range->[1] || ($val <= $range->[1])) { return 1; } } $val = _sillylog($val); my $r0 = _sillylog($range->[0]); my $r1; if (defined $range->[1]) { $r1 = _sillylog($range->[1]); } else { $r1 = 4; } my $width = $r1 - $r0; my $mean = ($r0 + $r1) / 2; my $stddev = $width / 2; my $n = ($val - $mean) / $stddev; # Normalized value our $mulconst; $mulconst ||= 0.999 * exp(1/8); return 0.001 + $mulconst * exp(-$n**2/2); } # Infinity-free logarithm sub _sillylog { my $x = shift; return log($x) if $x; return log(1e-50); } # pref_score : unitName -> score # # Maps a unit name (eg week) to a score. Higher scores are more likely # to be chosen. sub pref_score { my ($self, $unitName) = @_; my $prefs = $self->get_prefs(); my $specific = $prefs->{$unitName}; return defined($specific) ? $specific : $prefs->{default}; } # get_prefs : void -> { unit name => score } # # Return a map of unit names to their score, higher scores meaning # they're more likely to be chosen. sub get_prefs { return { default => 0.1 }; } sub get_ranges { return { default => [ 1, undef ] }; } # render_unit : unit name x power -> descriptive string # # Return a rendering of the given unit name and a power to raise the # unit to. # # Example: render_unit("weeks", 2) produces "weeks**2". # sub render_unit { my ($self, $name, $power, $options) = @_; if ($power == 1) { return $name; } else { return "$name**$power"; } } # render : value x name x power -> descriptive string # # Return a rendering of the given value with the given units. # # Example: render(4.8, "weeks", -1) produces "4.8 weeks**-1". # sub render { my ($self, $val, $name, $power, $options) = @_; return sprintf("%.5g ",$val).$self->render_unit($name, $power, $options); } sub construct { return; } 1; 07070100b27a7c00008124000027100000271000000001510fab64000004cc0000010000010027ffffffffffffffff0000003600000000root/opt/csw/share/perl/csw/Math/Calc/Units/Grammar.y# To process: yapp -s -m Math::Calc::Units::Grammar Grammar.y %{ use Math::Calc::Units::Compute qw(plus minus mult divide power construct); %} # Lowest %nonassoc BARE_UNIT %nonassoc NUMBER CONSTRUCT %left '+' '-' %left '*' '/' %left WORD %left '**' # Highest %% START : expr | '#' unit ; expr : expr '+' expr { return plus($_[1], $_[3]); } | expr '-' expr { return minus($_[1], $_[3]); } | expr '*' expr { return mult($_[1], $_[3]); } | expr '/' expr { return divide($_[1], $_[3]); } | expr '**' expr { return power($_[1], $_[3]); } | '(' expr ')' { return $_[2]; } | value { return $_[1]; } | expr unit { return mult($_[1], [ 1, $_[2] ]); } ; value : NUMBER unit { return [ $_[1] => $_[2] ] } | unit %prec BARE_UNIT { return [ 1 => $_[1] ] } | NUMBER { return [ $_[1] => {} ] } | '-' NUMBER { return [ -$_[2] => {} ] } | '@' NUMBER { return [ $_[2] => { 'timestamp' => 1 } ] } | CONSTRUCT { return construct($_[1]) } ; unit : WORD { return { $_[1] => 1 } } | WORD WORD { my $u = {}; $u->{$_[1]}++; $u->{$_[2]}++; return $u; } ; %% 07070100b27a7b00008124000027100000271000000001510fab6400003ba70000010000010027ffffffffffffffff0000003700000000root/opt/csw/share/perl/csw/Math/Calc/Units/Grammar.pm#################################################################### # # This file was generated using Parse::Yapp version 1.04. # # Don't edit this file, use source file instead. # # ANY CHANGE MADE HERE WILL BE LOST ! # #################################################################### package Math::Calc::Units::Grammar; use vars qw ( @ISA ); use strict; @ISA= qw ( Parse::Yapp::Driver ); #Included Parse/Yapp/Driver.pm file---------------------------------------- { # # Module Parse::Yapp::Driver # # This module is part of the Parse::Yapp package available on your # nearest CPAN # # Any use of this module in a standalone parser make the included # text under the same copyright as the Parse::Yapp module itself. # # This notice should remain unchanged. # # (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved. # (see the pod text in Parse::Yapp module for use and distribution rights) # package Parse::Yapp::Driver; require 5.004; use strict; use vars qw ( $VERSION $COMPATIBLE $FILENAME ); $VERSION = '1.04'; $COMPATIBLE = '0.07'; $FILENAME=__FILE__; use Carp; #Known parameters, all starting with YY (leading YY will be discarded) my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '', YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => ''); #Mandatory parameters my(@params)=('LEX','RULES','STATES'); sub new { my($class)=shift; my($errst,$nberr,$token,$value,$check,$dotpos); my($self)={ ERROR => \&_Error, ERRST => \$errst, NBERR => \$nberr, TOKEN => \$token, VALUE => \$value, DOTPOS => \$dotpos, STACK => [], DEBUG => 0, CHECK => \$check }; _CheckParams( [], \%params, \@_, $self ); exists($$self{VERSION}) and $$self{VERSION} < $COMPATIBLE and croak "Yapp driver version $VERSION ". "incompatible with version $$self{VERSION}:\n". "Please recompile parser module."; ref($class) and $class=ref($class); bless($self,$class); } sub YYParse { my($self)=shift; my($retval); _CheckParams( \@params, \%params, \@_, $self ); if($$self{DEBUG}) { _DBLoad(); $retval = eval '$self->_DBParse()';#Do not create stab entry on compile $@ and die $@; } else { $retval = $self->_Parse(); } $retval } sub YYData { my($self)=shift; exists($$self{USER}) or $$self{USER}={}; $$self{USER}; } sub YYErrok { my($self)=shift; ${$$self{ERRST}}=0; undef; } sub YYNberr { my($self)=shift; ${$$self{NBERR}}; } sub YYRecovering { my($self)=shift; ${$$self{ERRST}} != 0; } sub YYAbort { my($self)=shift; ${$$self{CHECK}}='ABORT'; undef; } sub YYAccept { my($self)=shift; ${$$self{CHECK}}='ACCEPT'; undef; } sub YYError { my($self)=shift; ${$$self{CHECK}}='ERROR'; undef; } sub YYSemval { my($self)=shift; my($index)= $_[0] - ${$$self{DOTPOS}} - 1; $index < 0 and -$index <= @{$$self{STACK}} and return $$self{STACK}[$index][1]; undef; #Invalid index } sub YYCurtok { my($self)=shift; @_ and ${$$self{TOKEN}}=$_[0]; ${$$self{TOKEN}}; } sub YYCurval { my($self)=shift; @_ and ${$$self{VALUE}}=$_[0]; ${$$self{VALUE}}; } sub YYExpect { my($self)=shift; keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}} } sub YYLexer { my($self)=shift; $$self{LEX}; } ################# # Private stuff # ################# sub _CheckParams { my($mandatory,$checklist,$inarray,$outhash)=@_; my($prm,$value); my($prmlst)={}; while(($prm,$value)=splice(@$inarray,0,2)) { $prm=uc($prm); exists($$checklist{$prm}) or croak("Unknow parameter '$prm'"); ref($value) eq $$checklist{$prm} or croak("Invalid value for parameter '$prm'"); $prm=unpack('@2A*',$prm); $$outhash{$prm}=$value; } for (@$mandatory) { exists($$outhash{$_}) or croak("Missing mandatory parameter '".lc($_)."'"); } } sub _Error { print "Parse error.\n"; } sub _DBLoad { { no strict 'refs'; exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ? and return; } my($fname)=__FILE__; my(@drv); open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname"; while() { /^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/ and do { s/^#DBG>//; push(@drv,$_); } } close(DRV); $drv[0]=~s/_P/_DBP/; eval join('',@drv); } #Note that for loading debugging version of the driver, #this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive. #So, DO NOT remove comment at end of sub !!! sub _Parse { my($self)=shift; my($rules,$states,$lex,$error) = @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' }; my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos) = @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' }; #DBG> my($debug)=$$self{DEBUG}; #DBG> my($dbgerror)=0; #DBG> my($ShowCurToken) = sub { #DBG> my($tok)='>'; #DBG> for (split('',$$token)) { #DBG> $tok.= (ord($_) < 32 or ord($_) > 126) #DBG> ? sprintf('<%02X>',ord($_)) #DBG> : $_; #DBG> } #DBG> $tok.='<'; #DBG> }; $$errstatus=0; $$nberror=0; ($$token,$$value)=(undef,undef); @$stack=( [ 0, undef ] ); $$check=''; while(1) { my($actions,$act,$stateno); $stateno=$$stack[-1][0]; $actions=$$states[$stateno]; #DBG> print STDERR ('-' x 40),"\n"; #DBG> $debug & 0x2 #DBG> and print STDERR "In state $stateno:\n"; #DBG> $debug & 0x08 #DBG> and print STDERR "Stack:[". #DBG> join(',',map { $$_[0] } @$stack). #DBG> "]\n"; if (exists($$actions{ACTIONS})) { defined($$token) or do { ($$token,$$value)=&$lex($self); #DBG> $debug & 0x01 #DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n"; }; $act= exists($$actions{ACTIONS}{$$token}) ? $$actions{ACTIONS}{$$token} : exists($$actions{DEFAULT}) ? $$actions{DEFAULT} : undef; } else { $act=$$actions{DEFAULT}; #DBG> $debug & 0x01 #DBG> and print STDERR "Don't need token.\n"; } defined($act) and do { $act > 0 and do { #shift #DBG> $debug & 0x04 #DBG> and print STDERR "Shift and go to state $act.\n"; $$errstatus and do { --$$errstatus; #DBG> $debug & 0x10 #DBG> and $dbgerror #DBG> and $$errstatus == 0 #DBG> and do { #DBG> print STDERR "**End of Error recovery.\n"; #DBG> $dbgerror=0; #DBG> }; }; push(@$stack,[ $act, $$value ]); $$token ne '' #Don't eat the eof and $$token=$$value=undef; next; }; #reduce my($lhs,$len,$code,@sempar,$semval); ($lhs,$len,$code)=@{$$rules[-$act]}; #DBG> $debug & 0x04 #DBG> and $act #DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): "; $act or $self->YYAccept(); $$dotpos=$len; unpack('A1',$lhs) eq '@' #In line rule and do { $lhs =~ /^\@[0-9]+\-([0-9]+)$/ or die "In line rule name '$lhs' ill formed: ". "report it as a BUG.\n"; $$dotpos = $1; }; @sempar = $$dotpos ? map { $$_[1] } @$stack[ -$$dotpos .. -1 ] : (); $semval = $code ? &$code( $self, @sempar ) : @sempar ? $sempar[0] : undef; splice(@$stack,-$len,$len); $$check eq 'ACCEPT' and do { #DBG> $debug & 0x04 #DBG> and print STDERR "Accept.\n"; return($semval); }; $$check eq 'ABORT' and do { #DBG> $debug & 0x04 #DBG> and print STDERR "Abort.\n"; return(undef); }; #DBG> $debug & 0x04 #DBG> and print STDERR "Back to state $$stack[-1][0], then "; $$check eq 'ERROR' or do { #DBG> $debug & 0x04 #DBG> and print STDERR #DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n"; #DBG> $debug & 0x10 #DBG> and $dbgerror #DBG> and $$errstatus == 0 #DBG> and do { #DBG> print STDERR "**End of Error recovery.\n"; #DBG> $dbgerror=0; #DBG> }; push(@$stack, [ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]); $$check=''; next; }; #DBG> $debug & 0x04 #DBG> and print STDERR "Forced Error recovery.\n"; $$check=''; }; #Error $$errstatus or do { $$errstatus = 1; &$error($self); $$errstatus # if 0, then YYErrok has been called or next; # so continue parsing #DBG> $debug & 0x10 #DBG> and do { #DBG> print STDERR "**Entering Error recovery.\n"; #DBG> ++$dbgerror; #DBG> }; ++$$nberror; }; $$errstatus == 3 #The next token is not valid: discard it and do { $$token eq '' # End of input: no hope and do { #DBG> $debug & 0x10 #DBG> and print STDERR "**At eof: aborting.\n"; return(undef); }; #DBG> $debug & 0x10 #DBG> and print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n"; $$token=$$value=undef; }; $$errstatus=3; while( @$stack and ( not exists($$states[$$stack[-1][0]]{ACTIONS}) or not exists($$states[$$stack[-1][0]]{ACTIONS}{error}) or $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) { #DBG> $debug & 0x10 #DBG> and print STDERR "**Pop state $$stack[-1][0].\n"; pop(@$stack); } @$stack or do { #DBG> $debug & 0x10 #DBG> and print STDERR "**No state left on stack: aborting.\n"; return(undef); }; #shift the error token #DBG> $debug & 0x10 #DBG> and print STDERR "**Shift \$error token and go to state ". #DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}. #DBG> ".\n"; push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]); } #never reached croak("Error in driver logic. Please, report it as a BUG"); }#_Parse #DO NOT remove comment 1; } #End of include-------------------------------------------------- #line 3 "Grammar.y" use Math::Calc::Units::Compute qw(plus minus mult divide power construct); sub new { my($class)=shift; ref($class) and $class=ref($class); my($self)=$class->SUPER::new( yyversion => '1.04', yystates => [ {#State 0 ACTIONS => { 'NUMBER' => 5, "#" => 2, "-" => 6, 'WORD' => 7, 'CONSTRUCT' => 3, "\@" => 9, "(" => 4 }, GOTOS => { 'unit' => 1, 'value' => 8, 'START' => 10, 'expr' => 11 } }, {#State 1 DEFAULT => -12 }, {#State 2 ACTIONS => { 'WORD' => 7 }, GOTOS => { 'unit' => 12 } }, {#State 3 DEFAULT => -16 }, {#State 4 ACTIONS => { 'NUMBER' => 5, "-" => 6, 'WORD' => 7, 'CONSTRUCT' => 3, "\@" => 9, "(" => 4 }, GOTOS => { 'unit' => 1, 'value' => 8, 'expr' => 13 } }, {#State 5 ACTIONS => { 'WORD' => 7 }, DEFAULT => -13, GOTOS => { 'unit' => 14 } }, {#State 6 ACTIONS => { 'NUMBER' => 15 } }, {#State 7 DEFAULT => -17 }, {#State 8 DEFAULT => -9 }, {#State 9 ACTIONS => { 'NUMBER' => 17 } }, {#State 10 ACTIONS => { '' => 18 } }, {#State 11 ACTIONS => { "*" => 21, "+" => 22, "**" => 20, "-" => 23, 'WORD' => 7, "/" => 24 }, DEFAULT => -1, GOTOS => { 'unit' => 19 } }, {#State 12 DEFAULT => -2 }, {#State 13 ACTIONS => { "*" => 21, "+" => 22, "**" => 20, "-" => 23, 'WORD' => 7, "/" => 24, ")" => 25 }, GOTOS => { 'unit' => 19 } }, {#State 14 DEFAULT => -11 }, {#State 15 DEFAULT => -14 }, {#State 16 DEFAULT => -18 }, {#State 17 DEFAULT => -15 }, {#State 18 DEFAULT => -0 }, {#State 19 DEFAULT => -10 }, {#State 20 ACTIONS => { 'NUMBER' => 5, "-" => 6, 'WORD' => 7, 'CONSTRUCT' => 3, "\@" => 9, "(" => 4 }, GOTOS => { 'unit' => 1, 'value' => 8, 'expr' => 26 } }, {#State 21 ACTIONS => { 'NUMBER' => 5, "-" => 6, 'WORD' => 7, 'CONSTRUCT' => 3, "\@" => 9, "(" => 4 }, GOTOS => { 'unit' => 1, 'value' => 8, 'expr' => 27 } }, {#State 22 ACTIONS => { 'NUMBER' => 5, "-" => 6, 'WORD' => 7, 'CONSTRUCT' => 3, "\@" => 9, "(" => 4 }, GOTOS => { 'unit' => 1, 'value' => 8, 'expr' => 28 } }, {#State 23 ACTIONS => { 'NUMBER' => 5, "-" => 6, 'WORD' => 7, 'CONSTRUCT' => 3, "\@" => 9, "(" => 4 }, GOTOS => { 'unit' => 1, 'value' => 8, 'expr' => 29 } }, {#State 24 ACTIONS => { 'NUMBER' => 5, "-" => 6, 'WORD' => 7, 'CONSTRUCT' => 3, "\@" => 9, "(" => 4 }, GOTOS => { 'unit' => 1, 'value' => 8, 'expr' => 30 } }, {#State 25 DEFAULT => -8 }, {#State 26 DEFAULT => -7, GOTOS => { 'unit' => 19 } }, {#State 27 ACTIONS => { "**" => 20, 'WORD' => 7 }, DEFAULT => -5, GOTOS => { 'unit' => 19 } }, {#State 28 ACTIONS => { "**" => 20, "*" => 21, 'WORD' => 7, "/" => 24 }, DEFAULT => -3, GOTOS => { 'unit' => 19 } }, {#State 29 ACTIONS => { "**" => 20, "*" => 21, 'WORD' => 7, "/" => 24 }, DEFAULT => -4, GOTOS => { 'unit' => 19 } }, {#State 30 ACTIONS => { "**" => 20, 'WORD' => 7 }, DEFAULT => -6, GOTOS => { 'unit' => 19 } } ], yyrules => [ [#Rule 0 '$start', 2, undef ], [#Rule 1 'START', 1, undef ], [#Rule 2 'START', 2, undef ], [#Rule 3 'expr', 3, sub #line 22 "Grammar.y" { return plus($_[1], $_[3]); } ], [#Rule 4 'expr', 3, sub #line 23 "Grammar.y" { return minus($_[1], $_[3]); } ], [#Rule 5 'expr', 3, sub #line 24 "Grammar.y" { return mult($_[1], $_[3]); } ], [#Rule 6 'expr', 3, sub #line 25 "Grammar.y" { return divide($_[1], $_[3]); } ], [#Rule 7 'expr', 3, sub #line 26 "Grammar.y" { return power($_[1], $_[3]); } ], [#Rule 8 'expr', 3, sub #line 27 "Grammar.y" { return $_[2]; } ], [#Rule 9 'expr', 1, sub #line 28 "Grammar.y" { return $_[1]; } ], [#Rule 10 'expr', 2, sub #line 29 "Grammar.y" { return mult($_[1], [ 1, $_[2] ]); } ], [#Rule 11 'value', 2, sub #line 33 "Grammar.y" { return [ $_[1] => $_[2] ] } ], [#Rule 12 'value', 1, sub #line 35 "Grammar.y" { return [ 1 => $_[1] ] } ], [#Rule 13 'value', 1, sub #line 36 "Grammar.y" { return [ $_[1] => {} ] } ], [#Rule 14 'value', 2, sub #line 37 "Grammar.y" { return [ -$_[2] => {} ] } ], [#Rule 15 'value', 2, sub #line 38 "Grammar.y" { return [ $_[2] => { 'timestamp' => 1 } ] } ], [#Rule 16 'value', 1, sub #line 39 "Grammar.y" { return construct($_[1]) } ], [#Rule 17 'unit', 1, sub #line 42 "Grammar.y" { return { $_[1] => 1 } } ], [#Rule 18 'unit', 2, sub #line 43 "Grammar.y" { my $u = {}; $u->{$_[1]}++; $u->{$_[2]}++; return $u; } ] ], @_); bless($self,$class); } #line 46 "Grammar.y" 1; 07070100b27a7000008124000027100000271000000001510fab640000067d0000010000010027ffffffffffffffff0000003700000000root/opt/csw/share/perl/csw/Math/Calc/Units/Convert.pmpackage Math::Calc::Units::Convert; use base 'Exporter'; use strict; use vars qw(@EXPORT_OK); BEGIN { @EXPORT_OK = qw(convert reduce canonical find_top construct); }; use Math::Calc::Units::Convert::Multi qw(to_canonical); # convert : value x unit -> value # # The lower-level conversion routines really only know how to convert # things to canonical units. But this routine may be called with eg # 120 minutes -> hours. So we convert both the current and target to # canonical units, and divide the first by the second. (Doesn't work # for adding units that aren't multiples of each other, but that's not # what this tool is for anyway.) sub convert { my ($from, $unit) = @_; my $to = [ 1, $unit ]; my $canon_from = canonical($from); my $canon_to = canonical($to); die "conversion between incompatible units" if not same_units($canon_from->[1], $canon_to->[1]); return [ $canon_from->[0] / $canon_to->[0], $unit ]; } # Are the (canonical) units compatible? (They must have exactly the # same base units, and each must be raised to exactly the same power.) sub same_units { my ($u1, $u2) = @_; return if keys %$u1 != keys %$u2; while (my ($bu1, $bp1) = each %$u1) { return if ! exists $u2->{$bu1}; return if $bp1 != $u2->{$bu1}; } return 1; } sub canonical { my ($v) = @_; my $c = to_canonical($v->[1]); my $w = [ $v->[0] * $c->[0], $c->[1] ]; return $w; } sub reduce { my ($v) = @_; return canonical($v, 'reduce, please'); } sub construct { my ($constructor, $args) = @_; return Math::Calc::Units::Convert::Multi::construct($constructor, $args); } 1; 07070100b27a6f00008124000027100000271000000001510fab64000011990000010000010027ffffffffffffffff0000003700000000root/opt/csw/share/perl/csw/Math/Calc/Units/Compute.pmpackage Math::Calc::Units::Compute; use base 'Exporter'; use vars qw(@EXPORT_OK); @EXPORT_OK = qw(compute plus minus mult divide power unit_mult unit_divide unit_power construct); use strict; use Math::Calc::Units::Convert qw(reduce); use Math::Calc::Units::Rank qw(render_unit); use Math::Calc::Units::Convert::Base; require Math::Calc::Units::Grammar; sub equivalent { my ($u, $v) = @_; return Math::Calc::Units::Convert::Base->same($u, $v); } sub is_unit { my ($x, $unit) = @_; return equivalent($x, { $unit => 1 }); } # All these assume the values are in canonical units. sub plus { my ($u, $v) = @_; $u = reduce($u); $v = reduce($v); if (equivalent($u->[1], $v->[1])) { return [ $u->[0] + $v->[0], $u->[1] ]; } elsif (is_unit($u->[1], 'timestamp') && is_unit($v->[1], 'sec')) { return [ $u->[0] + $v->[0], $u->[1] ]; } elsif (is_unit($u->[1], 'sec') && is_unit($v->[1], 'timestamp')) { return [ $u->[0] + $v->[0], $v->[1] ]; } die "Unable to add incompatible units `".render_unit($u->[1])."' and `".render_unit($v->[1])."'"; } sub minus { my ($u, $v) = @_; $u = reduce($u); $v = reduce($v); if (is_unit($u->[1], 'timestamp') && is_unit($v->[1], 'timestamp')) { return [ $u->[0] - $v->[0], { sec => 1 } ]; } elsif (equivalent($u->[1], $v->[1])) { return [ $u->[0] - $v->[0], $u->[1] ]; } elsif (is_unit($u->[1], 'timestamp') && is_unit($v->[1], 'sec')) { return [ $u->[0] - $v->[0], $u->[1] ]; } die "Unable to subtract incompatible units `".render_unit($u->[1])."' and `".render_unit($v->[1])."'"; } sub mult { my ($u, $v) = @_; return [ $u->[0] * $v->[0], unit_mult($u->[1], $v->[1]) ]; } sub divide { my ($u, $v) = @_; return [ $u->[0] / $v->[0], unit_divide($u->[1], $v->[1]) ]; } sub power { my ($u, $v) = @_; die "Can only raise to unit-less powers" if keys %{ $v->[1] }; $u = reduce($u); if (keys %{ $u->[1] } != 0) { my $power = $v->[0]; die "Can only raise a value with units to an integral power" if abs($power - int($power)) > 1e-20; return [ $u->[0] ** $power, unit_power($u->[1], $power) ]; } return [ $u->[0] ** $v->[0], {} ]; } sub unit_mult { my ($u, $v, $mult) = @_; $mult ||= 1; while (my ($unit, $vp) = each %$v) { $u->{$unit} += $vp * $mult; delete $u->{$unit} if $u->{$unit} == 0; # Keep zeroes out! } return $u; } sub unit_divide { my ($u, $v) = @_; return unit_mult($u, $v, -1); } sub unit_power { my ($u, $power) = @_; return {} if $power == 0; $u->{$_} *= $power foreach (keys %$u); return $u; } sub construct { my $s = shift; my ($constructor, $args) = $s =~ /^(\w+)\((.*)\)/; return Math::Calc::Units::Convert::construct($constructor, $args); } package Math::Calc::Units::Compute; # Poor-man's tokenizer sub tokenize { my $data = shift; my @tokens = $data =~ m{\s* ( \w+\([^\(\)]*\) # constructed (eg date(2001...)) |[\d.]+ # Numbers |\w+ # Words |\*\* # Exponentiation (**) |[-+*/()@] # Operators )}xg; my @types = map { /\w\(/ ? 'CONSTRUCT' :( /\d/ ? 'NUMBER' :( /\w/ ? 'WORD' :( $_))) } @tokens; return \@tokens, \@types; } # compute : string -> # # If the first character of the string is '#', this will attempt to avoid # canonicalization as much as possible. # sub compute { my $expr = shift; my $canonicalize = $expr !~ /^\#/; my ($vals, $types) = tokenize($expr); my $lexer = sub { # print "TOK($vals->[0]) TYPE($types->[0])\n" if @$vals; return shift(@$types), shift(@$vals) if (@$types); return ('', undef); }; my $parser = new Math::Calc::Units::Grammar; my $v = $parser->YYParse(yylex => $lexer, yyerror => sub { my $parser = shift; die "Error: expected ".join(" ", $parser->YYExpect)." got `".$parser->YYCurtok."', rest=".join(" ", @$types)."\nfrom ".join(" ", @$vals)."\n"; }, yydebug => 0); # 0x1f); return $canonicalize ? reduce($v) : $v; }; 1; 07070100b27a60000041ed000027100000271000000002510fb5a6000000000000010000010027ffffffffffffffff0000001100000000root/opt/csw/bin07070100b27a610000816d000027100000271000000001510fab640000088e0000010000010027ffffffffffffffff0000001700000000root/opt/csw/bin/ucalc#!/opt/csw/bin/perl eval 'exec /opt/csw/bin/perl -S $0 ${1+"$@"}' if 0; # not running under some shell use Getopt::Long; use File::Basename qw(basename); use Math::Calc::Units qw(convert readable calc); use strict; use warnings; sub usage { my ($msg, $bad) = @_; my $out = $bad ? *STDERR : *STDOUT; my $CMD = basename($0); if ($msg) { print $out "$CMD: $msg\n"; } print $out <<"END"; usage: Calculate the given expression, and guess human-readable units for the result: $CMD [-v] [-a] Convert the given expression to the requested units: $CMD -c $CMD --convert Examples: How long does it take to download 10MB over a 384 kilobit/sec connection? $CMD "10MB / 384Kbps" What is the expected I/O rate for 8KB reads on a disk that reads at 20MB/sec and has an average seek time of 15ms? $CMD "8KB / (8KB/(20MB/sec) + 15ms)" Or if you prefer to calculate that by figuring out the number of seconds per byte and inverting: $CMD "((1sec/20MB) + 15ms/8KB) ** -1" How many gigabytes can you transfer in a week at 2MB/sec? $CMD -c "2MB/sec" "GB/week" How many angels fit on the heads of 17 pins (with some assumptions)? (This demonstrates that unknown units are allowed, with plurals.) $CMD "42 angels/pinhead * 17 pinheads" END exit($bad ? 1 : 0); } my $verbose = 0; my $abbreviate = 0; my $action = 'readable'; GetOptions("verbose|v!" => \$verbose, "abbreviate|abbrev|a" => \$abbreviate, "convert|c!" => sub { $action = 'convert' }, "help|h!" => sub { usage("", 0) }, ) or usage("invalid arguments", 1); if ($action eq 'convert') { usage("not enough args", 1) if (@ARGV < 2); usage("too many args", 1) if (@ARGV > 2); my ($expr, $units) = @ARGV; if ($units =~ /^\s*\d+/) { warn("WARNING: Destination units in conversion should probably not have a value\n"); } print convert($expr, $units), "\n"; } elsif ($action eq 'readable') { usage("", 0) if @ARGV == 0; usage("too many ARGV", 1) if (@ARGV > 1); print "$_\n" foreach readable($ARGV[0], verbose => $verbose, abbreviate => $abbreviate); } 1; 07070100000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000b00000000TRAILER!!!