[139] | 1 | #!/usr/bin/perl
|
---|
| 2 | # ipdb/cgi-bin/newcity.cgi
|
---|
| 3 | # Add new city to database
|
---|
| 4 | ###
|
---|
| 5 | # SVN revision info
|
---|
| 6 | # $Date: 2013-05-14 22:10:22 +0000 (Tue, 14 May 2013) $
|
---|
| 7 | # SVN revision $Rev: 593 $
|
---|
| 8 | # Last update by $Author: kdeugau $
|
---|
| 9 | ###
|
---|
[445] | 10 | # Copyright (C) 2004-2010 - Kris Deugau
|
---|
[139] | 11 |
|
---|
| 12 | use strict;
|
---|
| 13 | use warnings;
|
---|
| 14 | #use CGI::Carp qw(fatalsToBrowser);
|
---|
[593] | 15 | use CGI::Simple;
|
---|
| 16 | use HTML::Template;
|
---|
[139] | 17 | use DBI;
|
---|
| 18 | #use POSIX qw(ceil);
|
---|
| 19 | use NetAddr::IP;
|
---|
| 20 |
|
---|
| 21 | use Sys::Syslog;
|
---|
| 22 |
|
---|
[445] | 23 | # don't remove! required for GNU/FHS-ish install from tarball
|
---|
| 24 | ##uselib##
|
---|
[139] | 25 |
|
---|
[445] | 26 | use MyIPDB;
|
---|
| 27 |
|
---|
| 28 | openlog "IPDB","pid","$IPDB::syslog_facility";
|
---|
| 29 |
|
---|
[139] | 30 | # Collect the username from HTTP auth. If undefined, we're in a test environment.
|
---|
| 31 | my $authuser;
|
---|
| 32 | if (!defined($ENV{'REMOTE_USER'})) {
|
---|
| 33 | $authuser = '__temptest';
|
---|
| 34 | } else {
|
---|
| 35 | $authuser = $ENV{'REMOTE_USER'};
|
---|
| 36 | }
|
---|
| 37 |
|
---|
[593] | 38 | # Set up the CGI object...
|
---|
| 39 | my $q = new CGI::Simple;
|
---|
| 40 | # ... and get query-string params as well as POST params if necessary
|
---|
| 41 | $q->parse_query_string;
|
---|
[139] | 42 |
|
---|
[593] | 43 | # Convenience; saves changing all references to %webvar
|
---|
| 44 | ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection)
|
---|
| 45 | my %webvar = $q->Vars;
|
---|
| 46 |
|
---|
[158] | 47 | my ($dbh,$errstr) = connectDB_My;
|
---|
[139] | 48 | my $sth;
|
---|
| 49 |
|
---|
[593] | 50 | $ENV{HTML_TEMPLATE_ROOT} = '../templates';
|
---|
[139] | 51 |
|
---|
[593] | 52 | my $page = HTML::Template->new(filename => "newcity.tmpl");
|
---|
[139] | 53 |
|
---|
[593] | 54 | if ($webvar{city}) {
|
---|
| 55 | if ($webvar{pop} eq 'on') {
|
---|
| 56 | $sth = $dbh->prepare("insert into cities (city,routing) values (?,'y')");
|
---|
| 57 | } else {
|
---|
| 58 | $sth = $dbh->prepare("insert into cities (city,routing) values (?,'n')");
|
---|
| 59 | }
|
---|
| 60 | ##fixme: don't allow duplicate cities
|
---|
| 61 | $sth->execute($webvar{city});
|
---|
| 62 | $page->param(city => $webvar{city});
|
---|
| 63 | if ($sth->err) {
|
---|
| 64 | $page->param(err => $sth->errstr);
|
---|
| 65 | my $msg = "$authuser could not add city '$webvar{city}' to database: ".$sth->errstr;
|
---|
| 66 | mailNotify($dbh, 'f:nci', "IPDB city add failure", $msg);
|
---|
| 67 | syslog "err", $msg;
|
---|
| 68 | } else {
|
---|
| 69 | syslog "notice", "$authuser added city/location '$webvar{pop}'".
|
---|
[139] | 70 | (($webvar{pop} eq 'on') ? ' as POP location' : '');
|
---|
[593] | 71 | }
|
---|
[139] | 72 | }
|
---|
| 73 |
|
---|
[593] | 74 | print "Content-type: text/html\n\n";
|
---|
| 75 |
|
---|
| 76 | print $page->output;
|
---|
| 77 |
|
---|
[139] | 78 | finish($dbh);
|
---|
[593] | 79 |
|
---|