1 | #!/usr/bin/perl |
---|
2 | |
---|
3 | use strict; |
---|
4 | use warnings; |
---|
5 | |
---|
6 | use FindBin; |
---|
7 | use AppConfig; |
---|
8 | |
---|
9 | # Find our private perl libraries |
---|
10 | use lib "$FindBin::Bin/../perllib"; |
---|
11 | use NPEMap; |
---|
12 | |
---|
13 | my $config = AppConfig->new( |
---|
14 | { GLOBAL => { |
---|
15 | ARGCOUNT => ARGCOUNT_ONE, |
---|
16 | EXPAND => EXPAND_ALL |
---|
17 | } |
---|
18 | }, |
---|
19 | 'sameonly|s!', |
---|
20 | ); |
---|
21 | |
---|
22 | $config->args; |
---|
23 | |
---|
24 | # Optionally, limit by the postcode ID |
---|
25 | my $postcode_id = shift; |
---|
26 | my $postcode_where = ""; |
---|
27 | if($postcode_id && $postcode_id =~ /^\d+$/) { |
---|
28 | $postcode_where = " AND p.id = $postcode_id "; |
---|
29 | } |
---|
30 | |
---|
31 | $postcode_where .= " AND prob_ip = sub_ip " if $config->sameonly; |
---|
32 | |
---|
33 | # Get the postcodes |
---|
34 | my $dbh = setup_dbh() or die $!; |
---|
35 | |
---|
36 | my $sql = <<EOF; |
---|
37 | SELECT p.id, outward, inward, p.ip AS sub_ip, b.ip AS prob_ip, b.reason, |
---|
38 | reporter_email, p.created_at AS sub_date, b.created_at AS prob_date, |
---|
39 | p.easting, p.northing, s.name AS source_name |
---|
40 | FROM bad_postcodes AS b INNER JOIN postcodes AS p ON (b.postcode = p.id) |
---|
41 | INNER JOIN sources AS s ON (p.source = s.id) |
---|
42 | WHERE not b.actioned $postcode_where |
---|
43 | ORDER BY p.id, b.created_at |
---|
44 | EOF |
---|
45 | |
---|
46 | my $sth = $dbh->prepare($sql); |
---|
47 | $sth->execute or die $dbh->errstr; |
---|
48 | |
---|
49 | if ($sth->rows == 0) { |
---|
50 | print "No problems\n"; |
---|
51 | exit 0; |
---|
52 | } |
---|
53 | |
---|
54 | # Build up a list of allowed IDs to delete |
---|
55 | my %probids; |
---|
56 | |
---|
57 | my $hr; |
---|
58 | while ($hr = $sth->fetchrow_hashref) { |
---|
59 | $probids{$hr->{'id'}}++; |
---|
60 | $hr->{'reporter_email'} = 'anon' unless $hr->{'reporter_email'}; |
---|
61 | $hr->{'prob_ip'} = 'unknown IP' unless $hr->{'prob_ip'}; |
---|
62 | $hr->{'sub_ip'} = '' unless $hr->{'sub_ip'}; |
---|
63 | print $hr->{'id'} . ': ' . $hr->{'outward'} . ' ' . $hr->{'inward'} . ': '; |
---|
64 | print "by " . $hr->{'reporter_email'}; |
---|
65 | print " at " . $hr->{'prob_ip'}; |
---|
66 | print ' (SAME IP)' if ($hr->{'prob_ip'} eq $hr->{'sub_ip'}); |
---|
67 | print "\n"; |
---|
68 | print " "; |
---|
69 | print "Reason: " . $hr->{'reason'} . ' ' if $hr->{'reason'}; |
---|
70 | print "(". $hr->{'prob_date'} . ")\n"; |
---|
71 | print " http://www.npemap.org.uk/tiles/map.html#" . |
---|
72 | int($hr->{'easting'} / 1000) . ',' . int($hr->{'northing'} / 1000) . ",1\n"; |
---|
73 | print " Source: " . $hr->{'source_name'} . "\n"; |
---|
74 | } |
---|
75 | |
---|
76 | my $delsth = $dbh->prepare("UPDATE postcodes SET deleted = 't', delete_reason = 1 WHERE id = ?"); |
---|
77 | my $actionsth = $dbh->prepare("UPDATE bad_postcodes SET actioned = 't' WHERE postcode = ?"); |
---|
78 | my $updsth = $dbh->prepare("UPDATE postcodes SET outward = ?, inward = ? WHERE id = ?"); |
---|
79 | |
---|
80 | # Now prompt for deletions |
---|
81 | |
---|
82 | print "Warning: no validation of postcodes input here\n"; |
---|
83 | while (1) { |
---|
84 | unless (%probids) { |
---|
85 | print "No more problems.\n"; |
---|
86 | last; |
---|
87 | } |
---|
88 | print "ID to resolve? (^C to exit): "; |
---|
89 | my $input = <STDIN>; |
---|
90 | chomp $input; |
---|
91 | if ($probids{$input}) { |
---|
92 | print "d for delete, i to ignore, comma separated postcode to update: "; |
---|
93 | my $input2 = <STDIN>; |
---|
94 | chomp $input2; |
---|
95 | if ($input2 =~ /^d$/i) { |
---|
96 | $delsth->execute($input) or warn $dbh->errstr; |
---|
97 | } elsif ($input2 =~ /^i$/i) { |
---|
98 | # Nothing. We'll mark it as actioned below |
---|
99 | } elsif ($input2 =~ /(\w*),(\w*)/) { |
---|
100 | $updsth->execute($1, $2, $input) or warn $dbh->errstr; |
---|
101 | } else { |
---|
102 | print "invalid input\n"; |
---|
103 | next; |
---|
104 | } |
---|
105 | $actionsth->execute($input) or warn $dbh->errstr; |
---|
106 | delete $probids{$input}; |
---|
107 | } else { |
---|
108 | print "$input is not a valid deletion candidate.\n"; |
---|
109 | } |
---|
110 | } |
---|
111 | |
---|
112 | $dbh->disconnect; |
---|