Vyššie na [Platon] / scripts / perl / accounting

Unnecessary warn removed.

#!/usr/bin/perl -w

#
# netacct-stats.cgi - Net accountig statistics
#
# Developed by Lubomir Host 'rajo' <rajo AT platon.sk>
# Copyright (c) 2005 Platon SDG, http://platon.sk/
# Licensed under terms of GNU General Public License.
# All rights reserved.
#
# Changelog:
# 2005-03-14 - created
#

# $Platon: scripts/perl/accounting/netacct-stats.cgi,v 1.4 2005/03/27 22:12:15 rajo Exp $

use strict;
umask 002;

$| = 1;

use FindBin;
use lib qw( ./modules );
use lib "$FindBin::Bin/../../../perl-modules";
use lib "$FindBin::Bin/perl-modules";

use Platon::MySQL::Cache;
use Platon::MySQL::Admin;

use DBI qw(:sql_types);
use Template;
use CGI;
use CGI::Lite;
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;
use Time::HiRes;
use POSIX qw(strftime);

use config;
use templates;
use db;

use vars qw (
    $cgi $template $db $config $auth $user
    $admin
    %query %cookie
    $start_gener_time $output
    $template_data
    @http_cookies @errors @messages
    $table_prefix $log_tables
);

sub print_output($$;);
sub is_num (@);

$start_gener_time     = Time::HiRes::time;

$cgi    = CGI::Lite->new();
%query  = $cgi->parse_new_form_data();
%cookie = $cgi->parse_cookies();

# we defined here, which templates we will use
$output = 'web';
if (defined $query{output}) {
    if ($query{output} eq 'web'
            or $query{output} eq 'wap'
            or $query{output} eq 'csv') {
        $output = $query{output};
    }
}

$config  = config->new();
$template    = templates->new($config, "./templates/$output");
#$tt    = templates->new([ . "./templates/$output", './templates']);
$db            = db->new($config);
$table_prefix = 'net_acct_';
$admin    = Platon::MySQL::Admin->new($db, { # {{{
        table    => "${table_prefix}config",
        primary_key_name    => 'config_id',
        select_columns        => [ qw(
            config_id
            config_order config_description ip_proto
            source_ip source_port
            dest_ip dest_port
            packet_count data_size
            interface ppp_user
        ) ],
        update_columns        => [ qw(
            config_order config_description ip_proto
            source_ip source_port
            dest_ip dest_port
            packet_count data_size
            interface ppp_user
        ) ],
        data_order            => [ 'config_order' ],

    }); # }}}

# TODO: user authentication
$user = { };
$user->{logged_in} = 1;

#
# MAIN:
#

$log_tables = $db->selectall_hashref("/* log_tables " . __FILE__ . ':' . __LINE__ . " */
     SHOW TABLE STATUS LIKE '${table_prefix}20%'
", 'Name');

foreach my $key (keys %$log_tables) {
    $log_tables->{$key}->{Date} = join('-', $key =~ m/(\d+)_(\d+)$/g);
}

$template_data = {
    query        => \%query,
    errors        => \@errors,
    messages    => \@messages,
    log_tables    => $log_tables,
};

unless(defined $query{template}) {
    $query{template} = 'intro';
}

if (defined $query{newtemplate} and  $query{newtemplate} ne '' and $query{newtemplate} ne 'logout') {
    $query{template} = $query{newtemplate};
}

if ($query{template} eq 'netacct/edit' or $query{template} eq 'netacct/new') { # {{{
    if (defined($query{store}) and $query{store} eq 'yes') {
        # vyhodime zbytocne medzery etc.
        $query{config_description}        =~ s/^\s+//g;
        $query{config_description}        =~ s/\s+$//g;
        $query{config_description}        =~ s/\s+/ /g;

        if ($query{template} eq 'netacct/edit') {
            $template_data->{changed_rows} = $admin->update_record(\%query);
        }
        else {
            $template_data->{new_id} = $admin->create_record(\%query);
        }
        $query{template} = 'netacct/config';
    }
    else {
        $template_data->{data}    = $admin->get_record($query{config_id}) if (defined $query{config_id});
    }
} # }}}
elsif ($query{template} eq 'netacct/delete') { # {{{
    $template_data->{delete_id} = $admin->delete_record($query{config_id});
    $query{template} = 'netacct/config';
} # }}}
elsif ($query{template} eq 'netacct/clearassign') { # {{{
    my $retval;
    foreach my $table (sort keys %$log_tables) {
        $retval = $db->do("/* netacct/clearassign " . __FILE__ . ':' . __LINE__ . " */
            UPDATE $table SET config_id = NULL
            ");
        push @errors, "There was a problem with updating table '$table': " . $db->errstr() unless $retval;
    }
    $query{template} = 'netacct/config';
} # }}}
elsif ($query{template} eq 'netacct/assign') { # {{{
    my $retval;
    my $data = $admin->get_data();

    my $update = $db->prepare("/* netacct/assign " . __FILE__ . ':' . __LINE__ . " */
        UPDATE ? SET config_id = ?
        WHERE
            ip_proto = ?
            AND (interface = ?        OR ? = '')
            AND (source_ip = ?        OR ? = '')
            AND (dest_ip = ?        OR ? = '')
            AND (source_port = ?    OR ? = 0)
            AND (dest_port = ?        OR ? = 0)
        ");
    foreach my $i (1..3, 10..13) {
        $update->bind_param($i, 0, SQL_INTEGER);
    }
    
    foreach my $table (sort keys %$log_tables) {
        push @messages, "Table $table:";
        foreach my $entry (@$data) {
            $update->execute(
                $table, $entry->{config_id},
                $entry->{ip_proto},
                $entry->{interface},    $entry->{interface},
                $entry->{source_ip},    $entry->{source_ip},
                $entry->{dest_ip},        $entry->{dest_ip},
                $entry->{source_port},    $entry->{source_port},
                $entry->{dest_port},    $entry->{dest_port}
            ) or push @errors, "There was a problem with updating table '$table': " . $db->errstr();
            push @messages, "\tEntry ID $entry->{config_id} matched " . $update->rows() . " rows.";
        }
    }
    $query{template} = 'netacct/config';
} # }}}
elsif ($query{template} eq 'netacct/typeless') { # {{{
    $query{page}    = 1        unless(is_num($query{page}) and $query{page} > 0);
    $query{pager}    = 10    unless(is_num($query{pager}) and $query{pager} > 0);
    if (is_num($query{record})) {
        $query{page} = int($query{record} / $query{pager});
        $query{page} = 1 if ($query{page} == 0);
    }
    else {
        $query{record}    = ($query{page} - 1) * $query{pager};
    }
    my $table = $table_prefix . '2005_01';
    if ($query{date} =~ m/^(\d{4})-(\d{2})$/g) {
        $table = "$table_prefix$1_$2";
    }
    else {
        $query{date} = '2005-01';
    }

    my $sql_search = $db->prepare("/* netacct/assign " . __FILE__ . ':' . __LINE__ . " */
        SELECT SQL_CALC_FOUND_ROWS
            id, created, ip_proto, source_ip, source_port, dest_ip, dest_port,
            packet_count, data_size, interface, ppp_user
        FROM ?
        WHERE config_id IS NULL
        ORDER BY id
        LIMIT ?, ?
    ");
    foreach my $i (1..3) {
        $sql_search->bind_param($i, 0, SQL_INTEGER);
    }
    
    $sql_search->execute(
        $table,
        $query{pager} * ($query{page} - 1),
        $query{pager}
    );
    $template_data->{data}            = $sql_search->fetchall_arrayref({});
    $template_data->{found_rows}    = $db->selectrow_array('SELECT FOUND_ROWS() AS found_rows');
    $template_data->{max_pages}        = int($template_data->{found_rows} / $query{pager}) + 1;
    $query{page} = $template_data->{max_pages} if ($query{page} > $template_data->{max_pages});
    $sql_search->finish();
    
} # }}}

if ($query{template} eq 'netacct/config') {
    $template_data->{data} = $admin->get_data();
}


print_output($template_data, $user);

sub print_output($$;)
{ # {{{
    my ($template_data, $user) = @_;

    if ($output eq 'web') {
        # nastav AUTH cookies pre web
        push @http_cookies, CGI::cookie(
            '-name'     => 'skey',
            '-value'    => $user->{skey},
            '-secure'   => 0,
            '-path'     => '/', # $config->cookie_path(),
            '-expires'  => '+3d',
        );
        push @http_cookies, CGI::cookie(
            '-name'        => 'remember_login',
            '-value'    => $user->{remember_login},
            '-secure'    => 0,
            '-expires'    => '+10y',
            #'-domain'    => $globals::cookie_domain,
            '-path'        => '/', # $globals::cookie_path,
        );
        $template_data->{cookie}        = \%cookie;
    }

    if ($output eq 'csv') {
        my $filename;
        if (defined $query{filename} and $query{filename} ne '') {
            $query{filename} =~ s/ /_/g;
            $query{filename} =~ s/:/-/g;
            $filename = $query{filename}.".csv";
        } else {
            my $time_string = strftime "%Y-%m-%d", localtime;
            $filename = "$query{action}_$time_string.csv";
        }
        print "Content-type: application/force-download; charset=iso8859-2\r\n";
        print "Content-disposition: attachment; filename=$filename\r\n\r\n";
    }

    $template_data->{user} = $user;
    #$template_data->{auth_status}    = $auth->status();

    $template->process("main.tt2", $template_data) or die $template->error(), "\n";
    exit;

} # }}} print_output

sub is_num (@)
{ # {{{
    my (@arr) = @_;

    if (@arr) {
        foreach my $val (@arr) {
            if (!defined $val or $val eq '' or $val !~ m/^\d+$/) {
                return 0;
            }
        }
        return 1;
    }
    else {
        return 0;
    }

} # }}}

# vim: ts=4
# vim600: fdm=marker fdl=0 fdc=3