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)";
} |
