irchelp.github.io/_scripts/t/netlist.t at 6cc18fca1fd1a284756aee64d50573a001c0c5bc · bw1/irchelp.github.io · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
#!/usr/bin/env perl
#
# check netlist.yaml and catlist.yaml
#
use strict;
use Test;
use CPAN::Meta::YAML;

require "./_scripts/t/global.inc";

BEGIN { plan tests=>8, todo=>[] }

# netlist read
my $fn="./_data/netlist.yaml";
my ( $ynet, $snet);
do {
	local *STDERR;
	open STDERR, '>>', \$snet;
	eval {
		open my $fh, "<:utf8", $fn;
		my $yt = do { local $/; <$fh> };
		$ynet=CPAN::Meta::YAML->read_string($yt);
		close $fh;
	};
	print STDERR $@;
};
my $r = "\n# ".join("\n# ",split(/\n/, $snet))."\n";
print STDERR $r if ($snet ne '');
ok($ynet); # netlist yaml error
ok($snet eq ''); # netlist yaml warnings

my $err='';
my @onlyp = qw/
  image
  homepage
  irchelp
  webchat
  slocation
  services
  support_channels
  information
  servers
  webserverlist
  webstatistic
  category
  status
  check
  comment
/;

my %onlyp;
foreach my $p ( @onlyp ) {
	$onlyp{$p}=0;
}
foreach my $net ( keys %{$ynet->[0]} ) {
	next if ($net eq 'property');
	foreach my $k ( keys %{$ynet->[0]->{$net}} ) {
		if ( !exists( $onlyp{$k} )) {
			$err .= "# unknown property $k in $net\n";
		}
	}
}
print STDERR "\n$err" if ($err ne '');
ok($err eq ''); # netlist only property

my $err='';
my @minp = qw/
  information
  servers
  category
  status
/;

foreach my $net ( keys %{$ynet->[0]} ) {
	next if ($net eq 'property');
	foreach my $k ( @minp ) {
		if ( !exists( $ynet->[0]->{$net}->{$k} )) {
			$err .= "# missing $k in $net\n";
		}
	}
}
print STDERR "\n$err" if ($err ne '');
ok($err eq ''); # netlist min property

# catlist read
my $fn="./_data/catlist.yaml";
my ($ycat, $scat);
do {
	local *STDERR;
	open STDERR, '>>', \$scat;
	eval {
		open my $fh, "<:utf8", $fn;
		my $yt = do { local $/; <$fh> };
		$ycat=CPAN::Meta::YAML->read_string($yt);
		close $fh;
	};
	print STDERR $@;
};
my $r = "\n# ".join("\n# ",split(/\n/, $scat))."\n";
print STDERR $r if ($scat ne '');
ok($ycat); # catlist yaml error
ok($scat eq ''); # catlist yaml warnings

my %cat;
my %ccat;
foreach my $net ( keys %{$ynet->[0]} ) {
	next if ($net eq 'property');
	next if ($ynet->[0]->{$net}->{status} ne 'active');
	foreach my $ca ( @{$ynet->[0]->{$net}->{category}} ) {
		$cat{$net}->{$ca}=0;
		$ccat{$ca}->{$net}=0;
	}
}

my $err='';
foreach my $ca ( keys %{$ycat->[0]} ) {
	foreach my $net ( @{$ycat->[0]->{$ca}} ) {
		if( !exists( $cat{$net}->{$ca} ) ) {
			$err .= "# catlist too much $net in $ca\n";
		}
	}
}
print STDERR $err if ($err ne '');
ok($err eq ''); # catlist too much

my $err='';
foreach my $ca ( keys %ccat ) {
	if ( !exists $ycat->[0]->{$ca} ) {
		$err .= "# catlist missing category  $ca\n";
		next;
	}
	my %n=();
	foreach my $net ( @{$ycat->[0]->{$ca}} ) {
		$n{$net}=0;
	}
	foreach my $net ( keys %{$ccat{$ca}} ) {
		if (!exists $n{$net}) {
			$err .= "# catlist missing $net in $ca\n";
		}
	}
}
print STDERR $err if ($err ne '');
ok($err eq ''); # catlist missing