#!/usr/bin/env perl # mksparse --- create sparse file # Author: Noah Friedman # Created: 2005-07-08 # Public domain # $Id: mksparse,v 1.2 2006/01/18 06:06:34 friedman Exp $ # Commentary: # Code: $^W = 1; # enable warnings use strict; use Symbol; use Fcntl qw(:DEFAULT :seek); my %mult = ( b => 512, k => 1024, t => 1024 ** 4, kib => 1024, tib => 1024 ** 4, kb => 1000, tb => 1000 ** 4, m => 1024 ** 2, p => 1024 ** 5, mib => 1024 ** 2, pib => 1024 ** 5, mb => 1000 ** 2, pb => 1000 ** 5, g => 1024 ** 3, e => 1024 ** 6, gib => 1024 ** 3, eib => 1024 ** 6, gb => 1000 ** 3, eb => 1000 ** 6, ); sub offset { my $val = shift; if ($val =~ /([a-z]+)$/i) { my $unit = $mult{lc $1}; $val =~ s///; return int ($val * ($unit || 1)); } return int ($val); } sub main { (my $progname = $0) =~ s=.*/==; unless (@_ == 2) { printf STDERR "Usage: %s [filename] [size{unit}] The size parameter can be an integral or fractional (decimal) quantity, though the actual file size will be truncated to the nearest whole byte. The optional unit can be specified as one of the following: k | m | g | t | p | e KiB | MiB | GiB | TiB | PiB | EiB which are interpreted as a multiple of 2**(10n) = 1024**n. For example, 4MiB = 4 * 1024**2 = 4194304 bytes. k = kibi = 2**10 (n=1) t = tebi = 2**40 (n=4) m = mebi = 2**20 (n=2) p = pebi = 2**50 (n=5) g = gibi = 2**30 (n=3) e = ebi = 2**60 (n=6) or the following SI metric units: KB | MB | GB | TB | PB | EB which are interpreted as multiples of 10**(3n) = 1000**n. For example, 4GB = 4 * 1000**3 = 4000000000 bytes. K = Kilo = 10**3 (n=1) T = Tera = 10**12 (n=4) M = Mega = 10**6 (n=2) P = Peta = 10**15 (n=5) G = Giga = 10**9 (n=3) E = Exa = 10**18 (n=6) Additionally, the unit \`b' (\"blocks\") will multiply the size by 512 (2**9), which is a traditional blocksize for many systems. See http://en.wikipedia.org/wiki/Binary_prefix for more information on the difference between SI (decimal) and binary prefix definitions.\n", $progname; exit (1); } my $filename = shift; my $off = offset (shift); my $fh = gensym; unless (sysopen ($fh, $filename, O_WRONLY|O_CREAT|O_EXCL, 0666)) { printf STDERR "%s: %s: %s\n", $progname, $filename, $!; exit (1); } unless ($off < 1 || sysseek ($fh, $off - 1, SEEK_SET)) { printf STDERR "%s: lseek: %s\n", $progname, $!; unlink ($filename); exit (2); } my $s = "\0"; unless ($off < 1 || syswrite ($fh, $s)) { printf STDERR "%s: write: %s\n", $progname, $!; unlink ($filename); exit (3); } close ($fh); exit (0); } main (@ARGV); # local variables: # mode: perl # end: # eof