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 Net::Icecast;
  12 use Apache::ASP;
  13
  14 require "/etc/icesnap.conf";
  15
  16 unless ( -e $outdir) {
  17   mkdir($outdir, 0755) or die "can't mkdir $outdir: $!";
  18 }
  19
  20 my $c = Net::Icecast->new($host, $port, $admin_password)
  21   or die "can't connect";
  22
  23 my %hash = $c->listeners;
  24
  25 #my %mount;
  26 use vars qw( %mount );
  27
  28 #produce blank pages
  29 foreach my $mount (qw( / /24 ) ) {
  30   $mount{$mount} = {};
  31 }
  32
  33 foreach my $listener ( keys %hash ) {
  34 #  print "$listener => \n";
  35   my %lhash = %{$hash{$listener}};
  36   foreach my $key ( keys %lhash ) {
  37 #    print "         $key => $lhash{$key}\n";
  38   }
  39
  40   $mount{$lhash{mountpoint}}{$lhash{user_agent}}++;
  41 }
  42
  43 #print "\n\n";
  44
  45 use vars qw($mount);
  46 foreach $mount ( keys %mount ) {
  47   my $total = 0;
  48   &writepage();
  49 #  print "$mount => \n";
  50 #  foreach my $user_agent ( keys %{$mount{$mount}} ) {
  51 #    $total += $mount{$mount}{$user_agent};
  52 #    print "        $user_agent => $mount{$mount}{$user_agent}\n";
  53 #  }
  54 #  print " TOTAL $total\n\n";
  55 }
  56
  57 sub writepage {
  58   #my $mount = shift;
  59 #  my %mount = %{shift()};
  60   #my $mref = shift;
  61
  62   open(STDOUT,">$outdir/$mount.html") or die "can't open $outdir/$mount.html: $!";
  63
  64   #nicked from cgi/asp in the Apache::ASP disribution
  65
  66   my $r = &Apache::ASP::CGI::init($template);
  67
  68   $r->dir_config('NoHeaders', 1);
  69
  70   &Apache::ASP::handler($r);
  71
  72   close STDOUT;
  73
  74 }
  75