Last active
March 10, 2024 08:39
-
-
Save joevt/0c75b42171b3fb1a5248b4e2bee8e4d0 to your computer and use it in GitHub Desktop.
Revisions
-
joevt revised this gist
Nov 18, 2021 . 1 changed file with 5 additions and 5 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -1,6 +1,6 @@ #!/bin/perl # by joevt Nov 18, 2021 use 5.010; use strict; @@ -307,11 +307,11 @@ sub parseioreg { my $thedispnodename = ""; while ( /$regex(?&node)/g ) { if ($nodename =~ /^(disp\d+)@.*/) { $thedispnodename = "$1"; } elsif ($nodename =~ /^(dispext\d+)@.*/) { $thedispnodename = "$1"; } my $thedict = parsenode(); -
Dec 31, 2020 . 1 changed file with 139 additions and 108 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -1,80 +1,69 @@ #!/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 { @@ -83,7 +72,7 @@ sub printvalue { if ( $lvalue =~ /^$regex(?&array)/ ) { my $litems = $items[$itemsndx-1]; printf("["); #print "«[" . $litems . "]»\n"; @@ -103,7 +92,7 @@ sub printvalue { if ($needcomma) { printf ("\n%*s", $depth * 2, ""); } printf("]"); } elsif ( $lvalue =~ /^$regex(?&dictionary)/ ) { @@ -117,7 +106,7 @@ sub printvalue { #print "«“" . $field[1] . " = " . $item[$itemndx-1] . "”»\n"; my $lfield = $field[0]; my $litem = $item[$itemndx-1]; if ($needcomma) { printf (","); @@ -144,17 +133,17 @@ sub printvalue { 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) { @@ -171,16 +160,19 @@ sub printioreg { } 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]; @@ -201,9 +193,12 @@ sub parsevalue { 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; @@ -272,40 +267,65 @@ sub parsevalue { } 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]; @@ -316,31 +336,43 @@ sub dumpstruct { 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) ) { @@ -360,13 +392,13 @@ sub dumpstruct { } 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" : "", @@ -396,16 +428,15 @@ sub dumpresolutions { } 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(); -
Dec 8, 2020 .There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,412 @@ #!/bin/perl # by joevt Dec 7, 2020 use strict; #use warnings; use JSON::PP; sub myinc { my $val = $_[0]; $_[0] = $val > 1 ? 3 : 2; return $val > 1 ? 2 : 1; } my $parseall = 1; my $nodenamendx = 1; my $propertiesndx = 1; my $propertyndx = 1; my $valuendx = 1; my $stringndx = 1; my $fieldndx = 1; my $fieldsndx = 1; my $itemsndx = 1; my $itemndx = 1; my @nodename = ("s","s"); my @properties = ("s","s"); my @property = ("s","s"); my @value = ("s","s"); my @string = ("s","s"); my @field = ("s","s"); my @fields = ("s","s"); my @items = ("s","s"); my @item = ("s","s"); #my $regex = qr 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. (?{ $nodenamendx = 1; $propertiesndx = 1; $propertyndx = 1; $valuendx = 1; $stringndx = 1; $fieldndx = 1; $fieldsndx = 1; $itemsndx = 1; $itemndx = 1; }) (?(DEFINE)(?'indent'^[|\ ]*+)) (?(DEFINE)(?'nodehead'(?&indent)\+\-o\ (?P<nodename>.*?)(?{$nodename[myinc($nodenamendx)]=$+{nodename}})\ \ <class\ (?P<classname>[^,]+).*\n)) (?(DEFINE)(?'nodeproperties'((?&indent)\{\n(?P<properties>(?&property)++)(?{$properties[myinc($propertiesndx)]=$+{properties}})(?&indent)\}\n|(?{$properties[myinc($propertiesndx)]=""})))) (?(DEFINE)(?'property'(?&indent)(?&string)(?{$property[myinc($propertyndx)]=$string[$stringndx-1]})\ =\ (?P<value>(?&item))(?{$value[myinc($valuendx)]=$+{value}}).*\n)) (?(DEFINE)(?'node'(?&nodehead)(?&nodeproperties))) (?(DEFINE)(?'string'"(?P<stringx>[^"]*+)"(?{$string[myinc($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[myinc($fieldndx)]=$string[$stringndx-1]})=(?&item))) (?(DEFINE)(?'dictionary'\{(?P<fields>(?:((?&field),)*+(?&field))|)(?{$fields[myinc($fieldsndx)]=$+{fields}})\})) (?(DEFINE)(?'array'\((?P<items>(?:((?&item),)*+(?&item))|)(?{$items[myinc($itemsndx)]=$+{items}})\))) (?(DEFINE)(?'dataarray'\<((?&item),)*+(?&item)\>)) (?(DEFINE)(?'item'(?P<itemx>(?:(?&dictionary)|(?&array)|(?&data)|(?&dataarray)|(?&datahex)|(?&string)|(?&number)|(?&boolean)))(?{$item[myinc($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[1]; 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]; my $properties = $_[1]; printf ("%*s\"%s\" : {", $depth * 2, "", $nodename[1]); $depth += 1; my $needcomma = 0; while ( $properties =~ /$regex(?&property)/g ) { if ($needcomma) { printf (","); } printf ("\n"); printf ("%*s\"%s\" : ", $depth * 2, "", $property[1]); printvalue($depth, $value[1]); $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[1]); printnode(0, $properties[1]); $needcomma = 1; } } my %thenodes = (); my $thenode = ""; 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]; my %thedict = (); while ( $lfields =~ /$regex(?&field)(,?)/g ) { my $lfield = $field[1]; 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 { my $depth = $_[0]; my $path = $_[1]; my $properties = $_[2]; $depth += 1; my $needcomma = 0; my %thedict = (); while ( $properties =~ /$regex(?&property)/g ) { if ( $parseall || ($property[1] =~ /TimingElements|DPTimingModeId/) ) { $thedict{$property[1]} = parsevalue($depth, $path . "/" . $property[1], $value[1]); } } return \%thedict; } sub parseioreg { while ( $_ =~ /$regex(?&node)/g ) { if ($nodename[1] =~ /^disp0@.*/) { $thenode = "disp0"; } elsif ($nodename[1] =~ /^dispext\d+@.*/) { $thenode = "dispext0"; } if ( $nodename[1] eq "AppleCLCD2" ) { $thenodes{$thenode} = parsenode(0, $thenode, $properties[1]); } } } sub dumpstruct { my $indenting = -1; my $inner; $inner = sub { my $ref = $_[0]; my $key = $_[1]; $indenting++; print ' ' x ($indenting * 4); if ($key) { print '"',$key,'"',' : '; } if (ref $ref eq 'ARRAY') { 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'){ 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 %thenodes){ print "\n$j:\n"; for my $k(@{$thenodes{$j}{"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 $thenodes{$j}{"DPTimingModeId"}) && $l{"ID"} eq $thenodes{$j}{"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(\%thenodes); # outputs JSON with indents #$utf8_encoded_json_text = encode_json( \%thenodes ); # outputs JSON with no white space #print $utf8_encoded_json_text . "\n"; dumpresolutions(); }