chiark / gitweb /
Default "overlapping" to relevant ones when you view a record or pick a network.
[bcp5-registry.git] / listdb.pl
1 # Routines for actually displaying (parts of) database in CGI output.
2 #
3 # Copyright (C) 1999 Ian Jackson <ijackson@chiark.greenend.org.uk>
4 #
5 # This is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as
7 # published by the Free Software Foundation; either version 2,
8 # or (at your option) any later version.
9 #
10 # This is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public
16 # License along with this file; if not, write to the Free Software
17 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18
19 sub list_database ($) {
20     my ($instyle) = @_;
21     my ($t, $v, $k, $x);
22 print DEBUG "ldb 0 $instyle\n";
23     $instyle =~ m/all|area|overlap/ or die "$instyle ?";
24     $listing= $&;
25     &{"dblist_prep_$listing"}();
26     @kl= ();
27 print DEBUG "ldb 1 $v @kl\n";
28     foreach $k (keys %db) {
29 print DEBUG "ldb q $k\n";
30         $ent= $db{$k};
31         next unless &{"dblist_cond_$listing"};
32         push @kl,$k;
33     }
34 print DEBUG "ldb 2 @kl\n";
35     @kl= sort {
36         $x= $db{$a}->{'network'} cmp $db{$b}->{'network'}; return $x if $x;
37         $x= $db{$a}->{'prefix'} <=> $db{$b}->{'prefix'}; return $x if $x;
38         return -1 if $a eq 'picked' && $b ne 'picked';
39         return +1 if $b eq 'picked' && $a ne 'picked';;
40         $x= $db{$a}->{'name'} cmp $db{$b}->{'name'}; return $x if $x;
41         $x= $db{$a}->{'contact'} cmp $db{$b}->{'contact'}; return $x if $x;
42         return $a cmp $b;
43     } @kl;
44 print DEBUG "ldb 3 @kl\n";
45     $listingnonefound= @kl ? 0 : 1;
46 print DEBUG "ldb end $listingnonefound\n";
47     $v= "listing$listing"; $$v= 1;
48     $list= 1;
49 }
50
51 sub dblist_prep_all { }
52 sub dblist_cond_all { 1; }
53
54 sub dblist_prep_area {
55     my ($network,$prefix);
56     $network= $area_networks[$list_areai];
57     $prefix= $area_prefixes[$list_areai];
58     $listarea= display_net($network,$prefix);
59     $dbl_mask= get_mask($prefix);
60     $dbl_value= hex($network);
61 }
62 sub dblist_cond_area {
63     my ($v, $r);
64     $v= hex($ent->{'network'});
65     $r= 1 if ($v & $dbl_mask) == $dbl_value;
66 print DEBUG "dblist_cond_area $k $v $r\n";
67     return $r;
68 }
69
70 sub dblist_prep_overlap {
71     my ($network,$prefix);
72     ($network,$prefix,$dbl_mask,$dbl_value) = parse_netrange($in{'with'});
73     $listoverlap= display_net($network,$prefix);
74 }
75 sub dblist_cond_overlap {
76     my ($v, $m);
77     $v= hex($ent->{'network'});
78     $m= get_mask($ent->{'prefix'});
79     $m &= $dbl_mask;
80     return ($v & $m) == ($dbl_value & $m);
81 }
82
83 sub foreach_start_db { $db_i=0; }
84 sub foreach_cond_db { return $db_i < @kl; }
85 sub foreach_incr_db { $db_i++; }
86 sub foreach_setvars_db {
87     my ($k, $ent);
88     $k= $kl[$db_i];
89     $ent= $db{$k};
90     $db_picked= $k eq 'picked';
91     if ($db_picked) {
92         undef $db_id;
93     } else {
94         $db_id= $k;
95     }
96     $db_net= display_net($ent->{'network'}, $ent->{'prefix'});
97     $db_name= html_sani($ent->{'name'});
98     $db_contact= html_sani($ent->{'contact'});
99     $db_hiddenemail= $ent->{'hiddenemail'};
100     $db_email= $db_hiddenemail ? "" : html_sani($ent->{'email'});
101     $db_confirmed= !!$ent->{'changed'};
102 }
103
104 1;