source: trunk/cgi-bin/snCalc.cgi

#!/usr/bin/perl

use strict;             
use warnings;   
use CGI::Carp qw(fatalsToBrowser);
use CGI::Simple;
use HTML::Template;
use NetAddr::IP;

#file snCalc.cgi        little subnet calculator app

# Set up the CGI object...
my $q = new CGI::Simple;
# ... and get query-string params as well as POST params if necessary
$q->parse_query_string;

# Convenience;  saves changing all references to %webvar
##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
my %webvar = $q->Vars;

my $input;

print "Content-Type: text/html\n\n";

##fixme:  need better method to find templates.
$ENV{HTML_TEMPLATE_ROOT} = $ENV{SCRIPT_FILENAME};
$ENV{HTML_TEMPLATE_ROOT} =~ s|cgi-bin/snCalc.cgi||;

my $page = HTML::Template->new(filename => "templates/subnet-calc.tmpl");

# Clean up input so we don't divide by zero or something equally silly
if ($webvar{input} =~ m/(\d+)/) {
  $input = 1*$1;
  $input = 3 if $input < 3;
  $input = 29 if $input > 29;   # Not doing IPv6 yet...
} else {
  $input = 29;
}

my $ltinput = $input - 1;
my $gtinput = $input + 1;

my $prenet = new NetAddr::IP "0.0.0.0/$ltinput";
my $net = new NetAddr::IP "0.0.0.0/$input";
my $postnet = new NetAddr::IP "0.0.0.0/$gtinput";

$page->param(prenet => $ltinput);
$page->param(net => $input);
$page->param(postnet => $gtinput);
$page->param(premask => $prenet->mask);
$page->param(mask => $net->mask);
$page->param(postmask => $postnet->mask);
$page->param(prewildcard => scalar($prenet->wildcard));
$page->param(wildcard => scalar($net->wildcard));
$page->param(postwildcard => scalar($postnet->wildcard));

my @prenets;
foreach (getranges($ltinput)) {
  my %row = (netrange => $_);
  push (@prenets, \%row);
}
$page->param(prenets => \@prenets);
my @nets;
foreach (getranges($input)) {
  my %row = (netrange => $_);
  push (@nets, \%row);
}
$page->param(nets => \@nets);
my @postnets;
foreach (getranges($gtinput)) {
  my %row = (netrange => $_);
  push @postnets, \%row;
}
$page->param(postnets => \@postnets);

print $page->output;
        
# Just In Case
exit 0;

# subs
sub xrange {
  my $block = shift;
  my $masklen = shift;
  my $data = $block->range;
  if ($masklen >= 24) {
    $data =~ s/\b0\.0\.0\./x.x.x./g;
  } elsif ($masklen >=16) {
    $data =~ s/\b0\.0\.(\d+\.\d+)/x.x.$1/g;
  } elsif ($masklen >=8) {
    $data =~ s/\b0\.(\d+\.\d+\.\d+)/x.$1/g;
  }
  return $data;
} # xrange()


sub getranges {
  my $masklen = shift;
  my @ret;
  my $super;
  if ($masklen < 8) {
    $super = new NetAddr::IP "0.0.0.0/0";
  } elsif ($masklen < 16) {
    $super = new NetAddr::IP "0.0.0.0/8";
  } elsif ($masklen < 24) {
    $super = new NetAddr::IP "0.0.0.0/16";
  } else {
    $super = new NetAddr::IP "0.0.0.0/24";
  }
  foreach my $net ($super->split($masklen)) {
    push @ret, xrange($net,$masklen);
  }
  return @ret;
} # getranges()