perl script parses ioreg output, can output JSON, dumps M1 Mac display timings.

ioreg.pl

#!/bin/perl

# by joevt Dec 30, 2020

use 5.010;
use strict;
#use warnings;
use Data::Dumper qw(Dumper);

use JSON::PP;

my $parseall = 1;

my $nodeindent = 0;
my $nodename = "";
my $thepath = "";
my $nodeid = "";
my $nodeflags = "";
my $classname = "";

my $propertyndx   = 0;
my $stringndx     = 0;
my $fieldndx      = 0;
my $fieldsndx     = 0;
my $itemsndx      = 0;
my $itemndx       = 0;

my @property = [];
my @value = [];
my @string = [];
my @field = [];
my @fields = [];
my @items = [];
my @item = [];

my $regex = qr !(?x) # ignore white space in regular expressions (means all spaces, tabs, and newlines need to be escaped)
(?m) # ^ matches line instead of start of string
#(?i) # ^ case insensitive
#(?p) # Preserve the string matched such that ${^PREMATCH}, ${^MATCH}, and ${^POSTMATCH} are available for use after matching.

(?{
	$stringndx     = 0;
	$fieldndx      = 0;
	$fieldsndx     = 0;
	$itemsndx      = 0;
	$itemndx       = 0;
})

(?(DEFINE)(?'indent'^[|\ ]*+))
(?(DEFINE)(?'nodehead'(?P<nodeindent>(?&indent))\+\-o\ (?P<nodename>.*?)\ \ <class\ (?P<classname>[^,]+),\ id\ (?P<nodeid>[^,]+),\ (?P<nodeflags>[^>]+)>\n(?{$nodename=$+{nodename}; $nodeindent=(length $+{nodeindent})/2; $classname=$+{classname}; $nodeid=$+{nodeid}; $nodeflags=$+{nodeflags}})))
(?(DEFINE)(?'nodeproperties'((?&indent)\{\n(?{$propertyndx=0;})(?&property)++(?&indent)\}\n|)))
(?(DEFINE)(?'property'(?&indent)(?&string)(?{$property[$propertyndx]=$string[$stringndx-1];})\ =\ (?P<value>(?&item))(?{$value[$propertyndx++]=$+{value};}).*\n))
(?(DEFINE)(?'node'(?&nodehead)(?&nodeproperties)))

(?(DEFINE)(?'string'"(?P<stringx>[^"]*+)"(?{$string[$stringndx++]=$+{stringx}})))
(?(DEFINE)(?'number'\d++))
(?(DEFINE)(?'boolean'(?:No|Yes)))
(?(DEFINE)(?'data'<[0-9a-f]*+>))
(?(DEFINE)(?'datahex'(?:\n(?&indent)[0-9A-F]++:(?:\ [0-9A-F]{2})++.*)++))
(?(DEFINE)(?'field'(?&string)(?{$field[$fieldndx++]=$string[$stringndx-1]})=(?&item)))
(?(DEFINE)(?'dictionary'\{(?P<fields>(?:((?&field),)*+(?&field))|)(?{$fields[$fieldsndx++]=$+{fields}})\}))
(?(DEFINE)(?'array'\((?P<items>(?:((?&item),)*+(?&item))|)(?{$items[$itemsndx++]=$+{items}})\)))
(?(DEFINE)(?'dataarray'\<((?&item),)*+(?&item)\>))

(?(DEFINE)(?'item'(?P<itemx>(?:(?&dictionary)|(?&array)|(?&data)|(?&dataarray)|(?&datahex)|(?&string)|(?&number)|(?&boolean)))(?{$item[$itemndx++]=$+{itemx}})))
!;


sub printvalue {
	my $depth = $_[0];
	my $lvalue = $_[1];

	if ( $lvalue =~ /^$regex(?&array)/ ) {
		my $litems = $items[$itemsndx-1];
		printf("[");
		
		#print "«[" . $litems . "]»\n";
		
		my $needcomma = 0;
		while ( $litems =~ /$regex(?&item),?/g ) {

			#print "«“" . $item[$itemndx-1] . "”»\n";

			my $litem = $item[$itemndx-1];
			if ($needcomma) {
				printf (",");
			}
			printf ("\n%*s", $depth * 2 + 2,  "");
			printvalue($depth + 1, $litem);
			$needcomma = 1;
		}
		if ($needcomma) {
			printf ("\n%*s", $depth * 2, "");
		}
		printf("]");
	}

	elsif ( $lvalue =~ /^$regex(?&dictionary)/ ) {
		my $lfields = $fields[$fieldsndx-1];
		printf("{");

		#print "«{" . $lfields . "}»\n";

		my $needcomma = 0;
		while ( $lfields =~ /$regex(?&field)(,?)/g ) {

			#print "«“" . $field[1] . " = " . $item[$itemndx-1] . "”»\n";

			my $lfield = $field[0];
			my $litem = $item[$itemndx-1];
			if ($needcomma) {
				printf (",");
			}
			printf("\n%*s\"%s\" : ", $depth * 2 + 2, "", $lfield);
			printvalue($depth + 1, $litem);
			$needcomma = 1;
		}
		if ($needcomma) {
			printf ("\n%*s", $depth * 2, "");
		}
		printf("}");
	}

	elsif ( $lvalue =~ /^$regex(?&datahex)/ ) {
		$lvalue =~ s/$regex(?&indent)(?P<achar>.)/' ' x ($depth * 2 + 2) . $+{achar}/ge;
		print $lvalue;
	}

	else {
		print $lvalue;
	}
}

sub printnode {
	my $depth = $_[0];
	printf ("%*s\"%s\" : {", $depth * 2, "", $nodename);
	$depth += 1;
	my $needcomma = 0;
	
	for (my $ndx = 0; $ndx < $propertyndx; $ndx++) {
		if ($needcomma) {
			printf (",");
		}
		printf ("\n");
		printf ("%*s\"%s\" : ", $depth * 2, "", $property[$ndx]);
		printvalue($depth, $value[$ndx]);
		$needcomma = 1;
	}
	if ($needcomma) {
		printf "\n";
	}
	print "}";
}

sub printioreg {
	my $needcomma = 0;
	while ( $_ =~ /$regex(?&node)/g ) {
		if ($needcomma) {
			printf (",");
		}
		printf ("\n");

		#printf ("%*s\"%s\" : {}", $depth * 2, "", $nodename);
		printnode(0);

		$needcomma = 1;
	}
}

my %root = (
		_1_indent => -1,
		_9_children => []
	);
my $prevnode = \%root;
my %dispnodes = ();

sub parsevalue {
	my $depth = $_[0];
	my $path = $_[1];
	my $lvalue = $_[2];

	if ( $lvalue =~ /^$regex(?&array)/ ) {
		my $litems = $items[$itemsndx-1];
		my @thearray = ();
		my $arrayndx = 0;
		while ( $litems =~ /$regex(?&item),?/g ) {
			my $litem = $item[$itemndx-1];
			$thearray[$arrayndx] = parsevalue($depth + 1, $path . '[' . $arrayndx . ']', $litem);
			$arrayndx++;
		}
		return \@thearray;
	}

	elsif ( $lvalue =~ /^$regex(?&dictionary)/ ) {
		my $lfields = $fields[$fieldsndx-1];

		#print "«{" . $lfields . "}»\n";

		my %thedict = ();
		while ( $lfields =~ /$regex(?&field)(,?)/g ) {
			my $lfield = $field[0];
			
			my $newpath = $path . '/' . $lfield;
			
			if ($parseall || ($newpath =~ 
				m"
					TimingElements\[\d+\](/
						(
							(
								ColorModes(\[\d+\]/
									ID
								)?
							)|
							(
								HorizontalAttributes(/
									(
										\w+
									)
								)?
							)|
							(
								VerticalAttributes(/
									(
										\w+
									)
								)?
							)|
							ID|
							IsInterlaced|
							IsOverscanned|
							IsPreferred|
							IsPromoted|
							IsSplit|
							IsVirtual
						)
					)?
				$"x))
			{
				my $litem = $item[$itemndx-1];
				$thedict{$lfield} = parsevalue($depth + 1, $newpath, $litem);
			}
		}
		return \%thedict;
	}

	elsif ( $lvalue =~ /^$regex(?&datahex)/ ) {
		$lvalue =~ s/^[ |]+[0-9A-F]+:((?: [0-9A-F]{2}){1,32}) .*/$1/gm;
		$lvalue =~ s/[\n ]//gm;
		return "<" . $lvalue . ">";
	}

	elsif ( $lvalue =~ /^$regex(?&number)/ ) {
		return $lvalue + 0;
	}
	
	elsif ( $lvalue =~ /^$regex(?&string)/ ) {
		return $string[$stringndx-1];
	}
	
	elsif ( $lvalue =~ /^$regex(?&boolean)/ ) {
		return ( $lvalue eq "Yes" ? JSON::PP::true : JSON::PP::false );
	}

	else {
		return $lvalue;
	}
}

sub parsenode {
	$thepath =~ s|^((/[^/]*){$nodeindent}).*|$1/$nodename|;

	my %thedict = (
		_1_indent => $nodeindent,
		_2_name => $nodename,
		_3_path => $thepath,
		_4_class => $classname,
		_5_id => $nodeid,
		_6_flags => $nodeflags,
		_7_properties => {},
		_9_children => []
	);
	
	my $parent = $prevnode;
	while ($parent->{"_1_indent"} >= $nodeindent) {
		$parent = $parent->{"_8_parent"};
	}
	$thedict{"_8_parent"} = $parent;

	for (my $ndx = 0; $ndx < $propertyndx; $ndx++) {
		if ( $parseall || ($property[$ndx] =~ /TimingElements|DPTimingModeId/) ) {
			#print "value:" . $value[$ndx] . "\n";
			$thedict{"_7_properties"}{$property[$ndx]} = parsevalue($nodeindent, $thepath . "/" . $property[$ndx], $value[$ndx]);
		}
	}

	push(@{$parent->{"_9_children"}}, \%thedict);
	$prevnode = \%thedict;

	#print "node:\n";
	#say Dumper \%thedict;
	#print "\n";

	return \%thedict;
}

sub parseioreg {
	my $thedispnodename = "";

	while ( /$regex(?&node)/g ) {
		if ($nodename =~ /^disp0@.*/) {
			$thedispnodename = "disp0";
		}
		elsif ($nodename =~ /^dispext\d+@.*/) {
			$thedispnodename = "dispext0";
		}
		my $thedict = parsenode();
		
		if ( $nodename eq "AppleCLCD2" ) {
			$dispnodes{$thedispnodename} = $thedict;
		}
	}
}

sub dumpstruct {
	my $indenting = -1;
	my $path = "";
	my %donenodes = ();
	
	my $inner; $inner = sub {
		my $ref = $_[0];
		my $key = $_[1];
		$indenting++;

		print ' ' x ($indenting * 4);
		if ($key) {
			print '"',$key,'"',' : ';
		}
		if (ref $ref eq 'ARRAY') {
			if (exists $donenodes{$ref}) {
				print "@" . $donenodes{$ref};
			}
			else {
				$donenodes{$ref} = $path;
				print "[";
				my $needcomma = 0;
				for my $k(@{$ref}) {
					if ($needcomma) {
						print ",";
					}
					print "\n";
					$inner->($k);
					$needcomma = 1;
				}
				#$inner->($_) for @{$ref};
				print "\n",' ' x ($indenting * 4),"]";
			}
		}
		elsif (ref $ref eq 'HASH'){
			if (exists $donenodes{$ref}) {
				print "%" . $donenodes{$ref};
			}
			else {
				$donenodes{$ref} = $path;
				print "{";
				my $needcomma = 0;
				for my $k(sort keys %{$ref}){
					if ($needcomma) {
						print ",";
					}
					print "\n";
					$inner->($ref->{$k},$k);
					$needcomma = 1;
				}
				print "\n",' ' x ($indenting * 4),"}";
			}
		}

		elsif ( JSON::PP::is_bool($ref) ) {
			print ($ref ? "true" : "false");
		}
		
		elsif (($ref ^ $ref) ne '0') {
			print '"',$ref,'"';
		}
		else {
			print $ref;
		}
		$indenting--;
	};
	$inner->($_) for @_;
	print "\n";
}

sub dumpresolutions {
	for my $j(sort keys %dispnodes){
		print "\n$j:\n";
		for my $k(@{$dispnodes{$j}{"_7_properties"}{"TimingElements"}}) {
			my %l = %$k;
			printf(
				"%s%dx%d%s@%.3fHz %.3fkHz %.2fMHz  h(%d %d %d %s)  v(%d %d %d %s)  %s%s%s%s%s\n",
				((exists $dispnodes{$j}{"_7_properties"}{"DPTimingModeId"}) && $l{"ID"} eq $dispnodes{$j}{"_7_properties"}{"DPTimingModeId"}) ? " -> " : "    ",
				$l{"HorizontalAttributes"}{"Active"},
				$l{"VerticalAttributes"}{"Active"},
				$l{"IsInterlaced"} ? "i" : "",

				$l{"VerticalAttributes"}{"PreciseSyncRate"} / 65536.0,
				$l{"HorizontalAttributes"}{"PreciseSyncRate"} / 65536.0,
				$l{"HorizontalAttributes"}{"PreciseSyncRate"} * $l{"HorizontalAttributes"}{"Total"} / 65536000.0,

				$l{"HorizontalAttributes"}{"FrontPorch"},
				$l{"HorizontalAttributes"}{"SyncWidth"},
				$l{"HorizontalAttributes"}{"BackPorch"},
				$l{"HorizontalAttributes"}{"SyncPolarity"} ? "+" : "-",

				$l{"VerticalAttributes"}{"FrontPorch"},
				$l{"VerticalAttributes"}{"SyncWidth"},
				$l{"VerticalAttributes"}{"BackPorch"},
				$l{"VerticalAttributes"}{"SyncPolarity"} ? "+" : "-",

				$l{"IsOverscanned"} ? " (overscan)" : "",
				$l{"IsPreferred"} ? " (preferred)" : "",
				$l{"IsPromoted"} ? " (promoted)" : "",
				$l{"IsSplit"} ? " (tiled)" : "",
				$l{"IsVirtual"} ? " (virtual)" : ""
			);
		}
	}
}

my $utf8_encoded_json_text = "";

while (<>) {
	#printioreg();

	parseioreg();

	#dumpstruct($root{"_9_children"}); # outputs JSON with indents

	#$utf8_encoded_json_text = encode_json( \%root ); # outputs JSON with no white space
	#print $utf8_encoded_json_text . "\n";
	
	dumpresolutions();
}

Download

curl -L https://gist.github.com/joevt/0c75b42171b3fb1a5248b4e2bee8e4d0/raw -o ~/Downloads/ioreg.pl

Run

on an M1 Mac get the ioreg info for the displays:
ioreg -filrw0 -k "display-timing-info" > ioreg_M1.txt

then use the downloaded script to list the timings:
cat ioreg_M1.txt | perl -0777 ~/Downloads/ioreg.pl

if you want to time how long it takes then do this:
time cat ioreg_M1.txt | perl -0777 ~/Downloads/ioreg.pl

Notes

• It takes a long time to parse ioreg (40 seconds). Maybe the regular expressions can be optimized more?
• A much faster solution is to do this in the ioreg.c code but regular expressions are more fun.
• It may be possible to build hashes and arrays in the regular expression instead of outside.

There is a faster script M1MacTimings.sh to dump the display timings. It uses the plist output option of ioreg. That output is modified slightly by sed (data changed to string) so it can be converted to json by plutil. Finally, that output is used by perl.