various small perl programs

also see varicode.pl, ascii.html

# rot13 | 2017-07-14
use strict; use warnings;
while (<>) {
	print $_ =~ tr/abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ/nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM/r;
}

# bits to bytes, MSB first | 2017-07-14
use strict; use warnings;
my @bits;
while (<>) {
	foreach my $bit (split //, $_) {
		push @bits, $bit if $bit =~ /[01]/;
		if (scalar(@bits) == 8) {
			print pack('B8', join('', @bits));
			@bits = ();
		}
	}
}

# bytes to bits, MSB first | 2017-07-14
use strict; use warnings;
while (<>) {
	foreach my $char (split //, $_) {
		print unpack('B8', $char);
	}
}

# bytes to hexes, most significant nybble first | 2017-07-14
use strict; use warnings;
while (<>) {
	foreach my $char (split //, $_) {
		print unpack('H2', $char);
	}
}



# colúmchop | 2017-07-14
use strict; use warnings; no warnings 'recursion'; use feature qw(say);
my $linelen = (defined($ARGV[0]) && $ARGV[0]=~/[0-9]+/) ? $ARGV[0] : 78;
while () {
	if (length($_) <= $linelen) {
		print $_;
	} else {
		my @lines = c($_, $linelen);
		my $lastline = pop @lines; # last line has newline in it
		foreach my $line (@lines) { say $line; }
		print $lastline; # so it needs separate treatment
	}
}
sub c {
	my ($str, $len) = @_;
	my $first = substr $str, 0, $len;
	my $rest = substr $str, $len;
	return ($first, length($rest) <= $len ? $rest : c($rest, $len));
}




# line count | 2017-07-14
use strict; use warnings; use feature qw(say);
my $lines = 0;
while (<>) { $lines++; }
say $lines;






Originally posted 2017-07-14 |
Last changed 2017-07-14
back to index