1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
|
#! /usr/bin/perl
use strict;
#~ use warnings;
# MODULES OBLIGATOIRES
use Tk;
use LWP::UserAgent;
use Getopt::Std;
use threads;
use threads::shared;
use locale;
# THREADS
sub maj (); # principal
sub text (); # mode texte -t
sub graph (); # mode graphique -g
# FONCTION PRINCIPALE
sub numbers ($);
# FONCTION AUXILIAIRE
sub HELP_MESSAGE;
# CODE PRINCIPAL
# options, traitement
$Getopt::Std::STANDARD_HELP_VERSION = 1;
our $VERSION = "0.1";
my %opts; getopts('vgtf:i:', \%opts);
die "Vous devez choisir le mode texte ou graphique avec -t/-v ou -g !\n" if not ($opts{t} or $opts{g} or $opts{v});
die "-v et -t sont incompatibles !\n" if $opts{t} and $opts{v};
$opts{i} = 600 if not $opts{i};
$opts{f} = "PERL" if not $opts{f};
# variables, déclaration et initialisation
$| = 1;
my $ua = LWP::UserAgent->new;
$ua->agent("Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)" . $ua->agent); # ua de IE6
my $req = HTTP::Request->new(GET => "http://<a href="http://www.developpez.net/forums/");" target="_blank">www.developpez.net/forums/");</a>
$req->header('Accept' => 'text/html');
my $messages :shared = 0;
my $topics : shared = 0;
($topics, $messages) = numbers $req;
my $ipt : shared = 0;
# mise en place de la surveillance :
print "Taper 'q' pour quitter.\n";
my $mainthread = threads->create( "maj" );
my ($graphthread, $textthread);
$graphthread = threads->create( "graph" ) if $opts{g};
$textthread = threads->create( "text" ) if $opts{t};
if( not $opts{g} ) {
while( <STDIN> ){
lock $ipt;
#~ $ipt = -1, last if /^q/;
exit if /^q/;
$ipt = 1;
}
}
$graphthread->join() if $opts{g};
$textthread->join() if $opts{t};
$mainthread->join();
# DEFINITION DES THREADS
sub maj () {
while(1) {
last if $ipt == -1;
my ($nt, $nm) = numbers $req;
print "\a\a" if $nm > $messages;
print (($nm - $messages). " nouveaux messages sur le forum Perl !!\n") if $nm > $messages and $opts{v};
print (($nt - $topics). " nouveaux topics !!\n") if $nt > $topics and $opts{v};
($topics, $messages) = ($nt,$nm);
sleep $opts{i};
}
return;
}
sub graph () {
my ($gmess, $gtop) = ($messages, $topics);
}
sub text () {
my ($tmess, $ttop, $time) = ($messages, $topics, scalar localtime());
my ($lm, $lt) = (1, 1);
print (($messages - $tmess) . " nouveaux messages depuis $time, ".
($topics - $ttop). " nouveaux topics.");
while (1) {
{
lock $ipt;
last if $ipt == -1;
if ($ipt == 1) {
($tmess, $ttop, $time) = ($messages, $topics, scalar localtime()) ;
my ($lm, $lt) = (1, 1);
print (($messages - $tmess) . " nouveaux messages depuis $time, ".
($topics - $ttop). " nouveaux topics.");
}
print "\b" x ($lm + 28 + length($time) +
$lt + 17);
print (($messages - $tmess) . " nouveaux messages depuis $time, ".
($topics - $ttop). " nouveaux topics.");
($lm, $lt) = (length($messages - $tmess), length($topics - $ttop));
$ipt = 0;
}
sleep int( $opts{i} / 3 );
}
return;
}
# DEFINITION DES FONCTIONS
sub numbers ($) {
print scalar localtime(), "\n" if $opts{v};
print "Send request\n" if $opts{v};
my $res = $ua->request($_[0]);
my $forum;
if ($res->is_success) {
$forum =$res->content;
print "Success of the request\n" if $opts{v};
print "Success of the regex\n" if $forum =~ m|\Q$opts{f}\E .+?
<td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
<td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
|ixms and $opts{v};
return ($1, $2);
}
else {
print "Error: " . $res->status_line . "\n";
return ($topics, $messages);
}
}
sub HELP_MESSAGE {
my $output = shift;
print $output "usage : program [-vg|-tg|-g] (-f forum -i intervalle\n)";
} |
Partager