#!/usr/bin/env perl
# ctl - write one-line strings to files
#
# To be used like `sysctl`, just for things outside /proc/sys.
# For example, ctl /sys/modules/snd_hda_intel/parameters/power_save=1
use warnings;
use strict;
use open qw(:std :utf8);
use File::Glob qw(:bsd_glob);
use Getopt::Long;

my $err;
my $value;
my $recurse = 0;
my $show_binary = 0;
my $color = (-t 1 || $ENV{COLOR});
my %c;

sub err($) { warn @_; ++$err; }

sub is_binary {
	my ($buf) = @_;
	return 1 if $buf !~ /^[\0\t\r\n\x20-\xFF]*$/g;
	return 0;
}

sub print_file_data {
	my ($file, $data, $more) = @_;
	$data =~ s/\e/$c{esc}\\e$c{reset}/g;
	$data =~ s/\0/$c{esc}\\0$c{reset}/g;
	$data =~ s/\r/$c{esc}\\r$c{reset}/g;
	$data =~ s/\n/$c{esc}\\n$c{reset}/g;
	$data =~ s/\t/$c{esc}\\t$c{reset}/g;
	$data =~ s/[\x00-\x1A\x1C-\x1F\x80-\xFF]/sprintf("$c{esc}\\%03o$c{reset}", ord $&)/ge;
	$data .= "$c{punct}<...>$c{reset}" if $more;
	print "$c{name}$file$c{reset} $c{punct}=$c{reset} $data\n";
}

sub write_ctl {
	my ($file, $data) = @_;

	if (my $fh = IO::File->new($file, "w")) {
		$fh->print($data."\n");
		if ($fh->flush()) {
			print_file_data($file, $data);
		} else {
			err "ctl: file '$file': $!\n";
		}
		$fh->close();
	} else {
		err "ctl: file '$file': $!\n";
	}
}

sub read_ctl {
	my ($file, $depth) = @_;

	if (-d $file && -l $file) {
		warn "$c{notice}ctl: skipping symlink '$file'$c{reset}\n";
	} elsif (-d $file) {
		$file =~ s|/+$||;
		if (!$recurse && $depth > 0) {
			warn "$c{notice}ctl: skipping directory '$file'$c{reset}\n";
		} elsif ($depth > 10) {
			warn "ctl: stopping descent into '$file/*'\n";
		} else {
			my @all = glob("$file/*");
			read_ctl($_, $depth+1) for (grep {!-d} @all), (grep {-d} @all);
		}
	} elsif (-f $file) {
		if (my $fh = IO::File->new($file, "r")) {
			my $data;
			my $foo;
			if ($fh->read($data, 512)) {
				chomp $data;
				if (is_binary($data) && !$show_binary) {
					print "$file: binary data\n";
				} else {
					print_file_data($file, $data, $fh->read($foo, 1));
				}
			} elsif ($!) {
				warn "$c{error}ctl: file '$file': read error ($!)$c{reset}\n";
			} else {
				print "$file: empty\n";
			}
			$fh->close();
		} else {
			err "$c{error}ctl: file '$file': open error ($!)$c{reset}\n";
		}
	} elsif (-e $file || -l $file) {
		warn "$c{notice}ctl: skipping non-regular file '$file'$c{reset}\n";
	} else {
		err "ctl: no such file '$file'\n";
	}
}

GetOptions(
	"color!" => \$color,
	"R|recurse!" => \$recurse,
	"v|value=s" => \$value,
) || exit(2);

%c = (
	esc => $color ? "\e[38;5;9m" : "",
	name => $color ? "\e[m\e[38;5;11m" : "",
	error => $color ? "\e[m\e[91m" : "",
	punct => $color ? "\e[2m" : "",
	notice => $color ? "\e[2m" : "",
	reset => $color ? "\e[m" : "",
);

push @ARGV, "." if !@ARGV;

for (@ARGV) {
	if (/^([^=]+)=(.*)$/) {
		write_ctl($1, $2);
	} elsif (defined $value) {
		write_ctl($_, $value);
	} else {
		read_ctl($_, 0);
	}
}

exit !!$err;
