File: humanRead.pl

package info (click to toggle)
storebackup 1.19-6
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 780 kB
  • ctags: 368
  • sloc: perl: 11,979; makefile: 48; sh: 43
file content (81 lines) | stat: -rw-r--r-- 2,136 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
# -*- perl -*-

#
#   Copyright (C) Heinz-Josef Claes (2000-2005)
#                 hjclaes@web.de
#   
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#   
#   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., 675 Mass Ave, Cambridge, MA 02139, USA.
#


push @VERSION, '$Id: humanRead.pl 336 2005-08-12 21:03:30Z hjc $ ';

use strict;

######################################################################
# Stellt eine Zahl als dreistellig + Zeichen dar, analog `df -h`
sub humanReadable
{
    my (@par) = (@_);
    my (@type) = (' ', 'k', 'M', 'G', 'T', 'P');
    my (@ret, $s);

    foreach $s (@par)
    {
	my $i;
	for ($i = 0 ; $i < @type - 1; $i++, $s /= 1024.)
	{
	    if ($s < 10)
	    {
		push @ret, sprintf("%.1f%s", $s, $type[$i]);
		goto nextNumber;
	    }
	    elsif ($s < 999.5)
	    {
		push @ret, sprintf("%3.0f%s", $s, $type[$i]);
		goto nextNumber;
	    }
	}
	push @ret, sprintf("%3.0f%s", $s, $type[$i]);
      nextNumber:;
    }

    return @ret;
}


######################################################################
sub packwithLen
{
    my $format = shift;  # pack format string, rest in @_ is argument to pack

    my $entry = pack($format, @_);
    return pack('S', length($entry)) . $entry;
}


######################################################################
sub unpackwithLen
{
    my $format = shift;
    my $packedData = shift;

    my $len = unpack('S', $packedData);
    # returns next entries of packedData und the unpacked values
    return (substr($packedData, $len + 2),
	    unpack($format, substr($packedData, 2)));
}

1