icesnap

   1 #!/usr/bin/perl -w
   2 #
   3 # Copyright (c) 2002 Ivan Kohler
   4 # All rights reserved.
   5 # This program is free software; you can redistribute it and/or modify it under
   6 # the same terms as Perl itself.
   7 #
   8 # ivan-icelog@420.am
   9
  10 use strict;
  11 use vars qw($host $port $admin_password $template $outdir);
  12 use Net::Icecast;
  13 use Apache::ASP;
  14
  15 require "/etc/icesnap.conf";
  16
  17 unless ( -e $outdir) {
  18   mkdir($outdir, 0755) or die "can't mkdir $outdir: $!";
  19 }
  20
  21 my $c = Net::Icecast->new($host, $port, $admin_password)
  22   or die "can't connect";
  23
  24 my %hash = $c->listeners;
  25
  26 #my %mount;
  27 use vars qw( %mount );
  28
  29 #produce blank pages
  30 foreach my $mount (qw( / /24 ) ) {
  31   $mount{$mount} = {};
  32 }
  33
  34 foreach my $listener ( keys %hash ) {
  35 #  print "$listener => \n";
  36   my %lhash = %{$hash{$listener}};
  37   foreach my $key ( keys %lhash ) {
  38 #    print "         $key => $lhash{$key}\n";
  39   }
  40
  41   $mount{$lhash{mountpoint}}{$lhash{user_agent}}++;
  42 }
  43
  44 #print "\n\n";
  45
  46 use vars qw($mount);
  47 foreach $mount ( keys %mount ) {
  48   my $total = 0;
  49   &writepage();
  50 #  print "$mount => \n";
  51 #  foreach my $user_agent ( keys %{$mount{$mount}} ) {
  52 #    $total += $mount{$mount}{$user_agent};
  53 #    print "        $user_agent => $mount{$mount}{$user_agent}\n";
  54 #  }
  55 #  print " TOTAL $total\n\n";
  56 }
  57
  58 sub writepage {
  59   #my $mount = shift;
  60 #  my %mount = %{shift()};
  61   #my $mref = shift;
  62
  63   open(STDOUT,">$outdir/$mount.html") or die "can't open $outdir/$mount.html: $!";
  64
  65   #nicked from cgi/asp in the Apache::ASP disribution
  66
  67   my $r = &Apache::ASP::CGI::init($template);
  68
  69   $r->dir_config('NoHeaders', 1);
  70
  71   &Apache::ASP::handler($r);
  72
  73   close STDOUT;
  74
  75 }
  76