IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Web Perl Discussion :

[web] [script] surveillance forum developpez.


Sujet :

Web Perl

  1. #21
    Membre actif
    Avatar de Choupi
    Profil pro
    Inscrit en
    Janvier 2003
    Messages
    223
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Janvier 2003
    Messages : 223
    Points : 235
    Points
    235
    Par défaut
    Citation Envoyé par nyal
    Je n'aime pas specialement tk (car j'ai toujours eu des problemes avec) mais c'est toujours mieux que un module non portable .
    Ben faut pas me faire complexer Version tk aussi en route de mon coté... faut juste s'assurer de laisser un maximum de modularité au code de Jedai.

    [Ajout 14h52]

    Bon je repasse donc en tk (nyal) étant adepte de linux (avait pas vu)

    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  2. #22
    Expert éminent
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    Avril 2003
    Messages
    6 245
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Avril 2003
    Messages : 6 245
    Points : 8 586
    Points
    8 586
    Par défaut
    Arf... Tk semble avoir de gros problème avec les threads !! Je vais faire une version graphique et alléger ma version textuelle :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
     
    #! /usr/bin/perl
    use strict;
    #~ use warnings;
     
     
     
    # MODULES OBLIGATOIRES
     
    use LWP::UserAgent;
    use Getopt::Std;
    use threads;
    use threads::shared;
    use Thread::Queue;
    use locale;
     
     
     
    # THREADS
     
    sub maj (); # principal
    sub text (); # mode texte -t
    sub reader (); # synchronisateur
     
     
     
    # 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('mvtf:i:', \%opts);
    die "Vous devez choisir le mode texte avec -t ou -v !\n"  if not ($opts{t} or $opts{g});
    die "Les modes -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;
    my $time : shared = localtime;
     
    # mise en place de la surveillance :
    print "Taper 'q' et valider pour quitter.\n";
     
    # gestion des threads et synchro
    my $mqueue : shared = Thread::Queue->new;
    my $tqueue : shared = Thread::Queue->new if $opts{t};
     
    my $mainthread = threads->create( "maj" );
     
    my ($textthread, $readerthread);
    $textthread = threads->create( "text" ) if $opts{t};
    $readerthread = threads->create( "reader" );
     
    CLOCK : while (1){
        last if $ipt;
        $mqueue->enqueue( 1 );
        sleep 2;
        last if $ipt;
        sleep 2;
        last if $ipt;
        sleep 2;
        last if $ipt;
        sleep 2;
        last if $ipt;
        sleep 2;
    }
     
     
    $mainthread->join();
    $textthread->join() if $opts{t};
    $readerthread->join();
     
     
     
    # DEFINITION DES THREADS
     
    sub maj () {
        my $mclock;
        MAJ : while(1) {
            my $sleeptime = 0;
            my ($nt, $nm) = numbers $req;
            print "\a\a" if $nm > $messages and (not $opts{m});
            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);
            $tqueue->enqueue( 1 );
     
     
            while(1) {
                $mclock = $mqueue->dequeue();
                last MAJ if not $mclock;
                $sleeptime += 10;
                last if $sleeptime >= $opts{i};
            }
        }
        return;
    }
     
    sub text () {
        my $tclock;
        my ($tmess, $ttop) = ($messages, $topics);
        my ($lm, $lt) = (1, 1);
        TEXT : while (1) {
     
            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));
     
            $tclock = $tqueue->dequeue();
            last TEXT if( not $tclock );
            if( $tclock == 2 ) {
                ($tmess, $ttop, $time) = ($messages, $topics, scalar localtime()) ;
                ($lm, $lt) = (1, 1);
                print (($messages - $tmess) . " nouveaux messages depuis $time, ".
                    ($topics - $ttop). " nouveaux topics.");        
            }
        }
        return;
    }
     
    sub reader () {
        while( <STDIN> ){
            if(/^q$/) {
                $ipt = 1;
                $tqueue->enqueue( 0 ) if $opts{t};
                $mqueue->enqueue( 0 );
                last;
            }
            $tqueue->enqueue( 2 ) if $opts{t};
        }
        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 <<'HELP';
    usage : program [options]
     
    > Options :
    Modes (incompatibles): 
    -v  : active le mode bavard
    -t  : active le mode textuel classique, <enter> réinitialise le compteur dans ce mode
    Arguments :
    -f forum    : donne le nom du forum que vous voulez surveiller
    -i intervalle   : le nombre de seconde entre chaque vérification
    -m  : muet, désactive l'émission d'un son lorsqu'un nouveau message est repéré
    HELP
    }
    C'est ainsi plus clair, non ?

    --
    Jedaï

  3. #23
    Expert éminent
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    Avril 2003
    Messages
    6 245
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Avril 2003
    Messages : 6 245
    Points : 8 586
    Points
    8 586
    Par défaut
    Juste par curiosité (et aussi pour tester mon script je l'avoue), qu'est ce qui rend PerlGtk supérieur à Tk pour toi Nyal ? Et as-tu une grande expérience avec le premier ? Sais-tu si on peut l'installer sous windows (sans trifouiller le source ...) ?


    --
    Jedaï

  4. #24
    Expert éminent
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    Avril 2003
    Messages
    6 245
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Avril 2003
    Messages : 6 245
    Points : 8 586
    Points
    8 586
    Par défaut
    J'ai une première version de mon script avec Tk, il lui manque les trois quarts des fonctionnalités, c'est affreusement laid, mais ça marche (plus ou moins). Donc si vous avez des suggestions sur la structure, elles seront les bienvenues, merci.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    #! /usr/bin/perl
    use strict;
    use warnings;
     
    # MODULES
    use Tk; use Tk::Table;
    use LWP::UserAgent;
     
     
    # INITIALISATION
     
    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 $accueil = get_page() or die "Impossible de contacter developpez.net\n";
     
    # liste des forums de developpez.net
    my @forums = ($accueil =~ m|<span \s* class="forumlink"> \s* <a [^>]*> \s* ([^<]+) \s* </a> \s* <br \s* />|ixg);
     
    # chaque entrée de ce tableau contient les informations suivantes : 
    # 0 nom du forum, 1 nombre de nouveaux messages, 2 nombres de nouveaux topics, 
    # 3 nombre de messages, 4 nombre de topics, 5 forum surveillé ou non, 6 nouveau message muet ou non,
    # 7 pop-up sur nouveau message ou non, 8 mail sur nouveau message ou non, 9 limite pour l'envoi d'un mail 
    my @main_info; 
    for (0..$#forums) {
        $accueil =~ m|\Q$forums[$_]\E .+?
                        <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                        <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                        |ixms;
        $main_info[$_] = [ $forums[$_], 0, 0, $2, $1, 0, 0, 0, 0, 1 ];
    }
     
    # intervalle en seconde entre deux mises à jour
    my $intervalle = 30;
     
    # MISE EN PLACE DE LA FENETRE
     
    my $mw = MainWindow->new( -title => 'Surveillance des forums de Développez.net');
    my $clock = $mw->repeat( $intervalle * 1000, \&maj ); 
     
    my(@pl) = qw/-side top -expand yes -padx 10 -pady 10 -fill both/;
    my $hight = $mw->Frame->pack(@pl);
    my $low = $mw->Frame->pack(@pl);
    @pl = qw/-side left -expand yes -padx 10 -pady 10 -fill both/;
    my $hleft = $hight->Frame->pack( @pl);
    my $hright = $hight->Frame->pack( @pl);
     
    $hleft->Button( -text => 'Réinitialiser',
                    -command => \&reset_count )->pack( qw/-side top -pady 10/ );
    $hleft->Button( -text => 'Options',
                    -command => \&prefs )->pack( qw/-side top -pady 10/ );
     
    $hright->Button( -text => 'Quitter',
                    -command => [ $mw => 'destroy' ] )->pack( qw/-side top -expand yes/ );
    my $date = $low->Label( -text => 'Décompte depuis ' . localtime() );
    $date->pack();
     
    my $table_f = $low->Table(-rows => (scalar(@forums) + 1),
                              -columns => 4,
                              -scrollbars => 'e',
                              -fixedrows => 1,
                              -takefocus => 1);
     
    $table_f->pack( -side => 'bottom' );;
    $table_f->put( 0, 0, $table_f->Label( -text => " Surveillé ? ", -relief => 'raise' ));
    $table_f->put( 0, 1, $table_f->Label( -text => "Forums", -relief => 'raise' ));
    $table_f->put( 0, 2, $table_f->Label( -text => "  Nouveaux messages  ", -relief => 'raise' ));
    $table_f->put( 0, 3, $table_f->Label( -text => "  Nouveaux topics  ", -relief => 'raise'  ));  
     
    create_table();
     
     
    $mw->maxsize( 1024, 600 );
     
    MainLoop();
     
    # CALLBACKS
     
     
    sub create_table {
        for (0..$#main_info) {
            my $widget = $table_f->Checkbutton( -text => "", 
                                                -variable => \$main_info[$_][5] );
            $table_f->put( $_ + 1, 0, $widget );
            $widget = $table_f->Label( -text => $main_info[$_][0] );
            $table_f->put( $_ + 1, 1, $widget );
            $widget = $table_f->Label( -text => $main_info[$_][1] );
            $table_f->put( $_ + 1, 2, $widget );
            $widget = $table_f->Label( -text => $main_info[$_][2] );
            $table_f->put( $_ + 1, 3, $widget );
        }
    }
     
    sub refresh {
        for (0..$#main_info) {
            my $widget = $table_f->get( $_ + 1, 2);
            $widget->configure( -text => $main_info[$_][1] );
            $widget = $table_f->get( $_ + 1, 3);
            $widget->configure( -text => $main_info[$_][2] );
        }
    }
     
    sub reset_count {
        $date->configure( -text => 'Décompte depuis ' . localtime() );
        for (0..$#main_info) {
            $main_info[$_][1] = 0;$main_info[$_][2] = 0;
        }
        refresh();
    }
     
    sub get_page {
        my $res = $ua->request($req);
     
        if ($res->is_success) {
            return $res->content;
        }
        else {
            print "Error: " . $res->status_line . "\n";
            return $accueil;
        }
    }
     
    sub maj {
        $accueil = get_page();
        for (0..$#main_info) {
            if( $main_info[$_][5] ) {
                my $forum = $main_info[$_][0];
                $accueil =~ m|\Q$forum\E .+?
                            <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                            <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                            |ixms;
                print "\a\a" if (not $main_info[$_][6]) and $2 > $main_info[$_][3];
                $main_info[$_][1] += ($2 - $main_info[$_][3]);$main_info[$_][2] += ($1 - $main_info[$_][4]);
                $main_info[$_][3] = $2;$main_info[$_][4] = $1;
                popup( $_ ) if $main_info[$_][7] ;
                mail( $_ ) if $main_info[$_][8] and $main_info[$_][1] > $main_info[$_][9];
            }
        }
        refresh();
    }
     
    sub popup {
     
    }
    --
    Jedaï

  5. #25
    Membre expérimenté
    Avatar de nyal
    Profil pro
    Inscrit en
    Septembre 2002
    Messages
    622
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Septembre 2002
    Messages : 622
    Points : 1 428
    Points
    1 428
    Par défaut
    Citation Envoyé par Jedai
    Juste par curiosité (et aussi pour tester mon script je l'avoue), qu'est ce qui rend PerlGtk supérieur à Tk pour toi Nyal ? Et as-tu une grande expérience avec le premier ? Sais-tu si on peut l'installer sous windows (sans trifouiller le source ...) ?
    Ca fait un bout de temps que j'ai developpe des interfaces graphiques en gtk que ce soit en C ou perl. Et je trouve que cette librairie est tres bien. Elle est bien pensée (orienté objet), plutot rapide, facile a developper, les nombreuses widgets presentes (ya meme une widget mplayer ), agreable graphiquement (contrairement a tk que je trouve un peu vieillot), les themes nombreux,....

    Je pense qu'elle est installable sous windows sans gros probleme.

  6. #26
    Membre actif
    Avatar de Choupi
    Profil pro
    Inscrit en
    Janvier 2003
    Messages
    223
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Janvier 2003
    Messages : 223
    Points : 235
    Points
    235
    Par défaut
    Citation Envoyé par Jedai
    c'est affreusement laid, mais ça marche (plus ou moins). Donc si vous avez des suggestions sur la structure, elles seront les bienvenues, merci.
    Ben laid, c'est tk Comme moi tu n'utilises plus de threads... Par contre j'utilise Hlist et du coup la remise à jour est compliquee !! C'est bcp mieux Table.

    Pour Gtk, sous windows c'est lourd... et faut mieux utiliser l'api win32, on conserve la charte graphique (gtk c'est parfois beau aussi)...
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  7. #27
    Jeh
    Jeh est déconnecté
    Membre actif Avatar de Jeh
    Profil pro
    Inscrit en
    Septembre 2003
    Messages
    203
    Détails du profil
    Informations personnelles :
    Âge : 42
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations forums :
    Inscription : Septembre 2003
    Messages : 203
    Points : 250
    Points
    250
    Par défaut
    Citation Envoyé par Choupi
    Sinon toujours la question sous windows, on peut avoir le programme en barre des taches avec perl ?
    Une solution : créer un raccourci vers cmd du type :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    C:\WINNT\system32\CMD.EXE /k "C:\Perl\bin\perl.exe C:\verif_topic_dev.pl"
    Verre vide je te plains, verre plein, je te vide.

  8. #28
    Membre actif
    Avatar de Choupi
    Profil pro
    Inscrit en
    Janvier 2003
    Messages
    223
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Janvier 2003
    Messages : 223
    Points : 235
    Points
    235
    Par défaut
    Citation Envoyé par Jeh
    Une solution : créer un raccourci vers cmd du type :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    C:\WINNT\system32\CMD.EXE /k "C:\Perl\bin\perl.exe C:\verif_topic_dev.pl"
    Je connaissais pas ... Une solution simple avec l'api win32::Gui :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    my $icon = new Win32::GUI::Icon('logo.ico');
     
    my $main = Win32::GUI::Window->new();				    
     
    my $ni = $main->AddNotifyIcon(-name => "NI", -id => 1,-icon => $icon, -tip => "Forum Developpez !");
    On peut gere les baloon tips... J'ai vraiment apprécier!
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  9. #29
    Expert éminent
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    Avril 2003
    Messages
    6 245
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Avril 2003
    Messages : 6 245
    Points : 8 586
    Points
    8 586
    Par défaut
    J'ai un peu remanié le code (un peu), et les popups marchent maintenant, ce qui est bien pratique !
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
     
    #! /usr/bin/perl
    use strict;
    use warnings;
     
    # MODULES
    use Tk; use Tk::Table;
    use LWP::UserAgent;
     
     
    # INITIALISATION
     
    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 $accueil = get_page() or die "Impossible de contacter developpez.net\n";
     
    # liste des forums de developpez.net
    my @forums = ($accueil =~ m|<span \s* class="forumlink"> \s* <a [^>]*> \s* ([^<]+) \s* </a> \s* <br \s* />|ixg);
     
    # chaque entrée de ce tableau contient les informations suivantes : 
    # 0 nom du forum, 1 nombre de nouveaux messages, 2 nombres de nouveaux topics, 
    # 3 nombre de messages, 4 nombre de topics, 5 forum surveillé ou non, 6 son pour nouveau message ou non,
    # 7 pop-up sur nouveau message ou non, 8 mail sur nouveau message ou non, 9 limite pour l'envoi d'un mail 
    my @main_info; 
    for (0..$#forums) {
        $accueil =~ m|\Q$forums[$_]\E .+?
                        <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                        <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                        |ixms;
        $main_info[$_] = [ $forums[$_], 0, 0, $2, $1, 0, 1, 1, 0, 1 ];
    }
     
    # intervalle en seconde entre deux mises à jour
    my $intervalle = 120;
     
    # MISE EN PLACE DE LA FENETRE
     
    my $mw = MainWindow->new( -title => 'Surveillance des forums de Développez.net');
    my $clock = $mw->repeat( $intervalle * 1000, \&maj ); 
     
    my(@pl) = qw/-side top -expand yes -padx 10 -pady 10 -fill both/;
    my $hight = $mw->Frame;
    $hight->pack(qw/-side top -padx 10 -pady 5 -fill x/);
    my $low = $mw->Frame;
    $low->pack(@pl);
    @pl = qw/-side left -padx 10 -expand yes -fill x/;
    my $hleft = $hight->Frame;
    $hleft->pack( @pl);
    my $hright = $hight->Frame;
    $hright->pack( @pl);
     
    $hleft->Button( -text => 'Réinitialiser',
                    -command => \&reset_count )->pack( qw/-anchor w -side top -pady 1/ );
    $hleft->Button( -text => 'Options',
                    -command => \&prefs )->pack( qw/-anchor w -side top -pady 1/ );
     
    $hright->Button( -text => 'Quitter',
                    -command => [ $mw => 'destroy' ] )->pack( qw/-anchor e -side top -expand yes/ );
    my $date = $low->Label( -text => 'Décompte depuis ' . localtime() );
    $date->pack();
     
    my $table_f = $low->Table(-rows => (scalar(@forums) + 1),
                              -columns => 4,
                              -scrollbars => 'e',
                              -fixedrows => 1,
                              -takefocus => 1);
     
    $table_f->pack( -side => 'bottom' );;
    $table_f->put( 0, 0, $table_f->Label( -text => " Surveillé ? ", -relief => 'raise' ));
    $table_f->put( 0, 1, $table_f->Label( -text => "Forums", -relief => 'raise' ));
    $table_f->put( 0, 2, $table_f->Label( -text => "  Nouveaux messages  ", -relief => 'raise' ));
    $table_f->put( 0, 3, $table_f->Label( -text => "  Nouveaux topics  ", -relief => 'raise'  ));  
     
    create_table();
     
    $mw->maxsize( 1024, 600 );
     
    MainLoop();
     
    # CALLBACKS
     
     
    sub create_table {
        for (0..$#main_info) {
            my $widget = $table_f->Checkbutton( -text => "", 
                                                -variable => \$main_info[$_][5],
                                                -command => [\&change_surv_state => $_]);
            $table_f->put( $_ + 1, 0, $widget );
            $widget = $table_f->Label( -text => $main_info[$_][0] );
            $table_f->put( $_ + 1, 1, $widget );
            $widget = $table_f->Label( -text => $main_info[$_][1] );
            $table_f->put( $_ + 1, 2, $widget );
            $widget = $table_f->Label( -text => $main_info[$_][2] );
            $table_f->put( $_ + 1, 3, $widget );
        }
    }
     
    sub change_surv_state {
        my $forum = shift;
        if( not $main_info[$forum][5] ) {
            $main_info[$forum][1] = 0;$main_info[$forum][2] = 0;
            refresh( 1, $forum );
        }
    }
     
    sub refresh {
        my $only = shift;
        if ( $only ) {
            if( @_ ) {
                my $widget = $table_f->get( $_[0] + 1, 2);
                $widget->configure( -text => $main_info[$_][1] );
                $widget = $table_f->get( $_[0] + 1, 3);
                $widget->configure( -text => $main_info[$_][2] );
            }
            else {
                for (0..$#main_info) {
                    if( $main_info[$_][5] ) {
                        my $widget = $table_f->get( $_ + 1, 2);
                        $widget->configure( -text => $main_info[$_][1] );
                        $widget = $table_f->get( $_ + 1, 3);
                        $widget->configure( -text => $main_info[$_][2] );
                    }
                }
            }
        }
        else {
            for (0..$#main_info) {
                my $widget = $table_f->get( $_ + 1, 2);
                $widget->configure( -text => $main_info[$_][1] );
                $widget = $table_f->get( $_ + 1, 3);
                $widget->configure( -text => $main_info[$_][2] );
            }
     
        }
    }
     
    sub reset_count {
        $date->configure( -text => 'Décompte depuis ' . localtime() );
        for (0..$#main_info) {
            $main_info[$_][1] = 0;$main_info[$_][2] = 0;
        }
        refresh( 0 );
    }
     
    sub get_page {
        my $res = $ua->request($req);
     
        if ($res->is_success) {
            return $res->content;
        }
        else {
            print "Error: " . $res->status_line . "\n";
            return undef;
        }
    }
     
    sub maj {
        $accueil = get_page() or return;
        for (0..$#main_info) {
            if( $main_info[$_][5] ) {
                my $forum = $main_info[$_][0];
                if( $accueil =~ m|\Q$forum\E .+?
                            <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                            <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                            |ixms ) {
                    if( $2 > $main_info[$_][3] ) {
                        print "\a\a" if ($main_info[$_][6]);
                        popup( $_ ) if $main_info[$_][7] ;
                        mail( $_ ) if $main_info[$_][8] and $main_info[$_][1] > $main_info[$_][9];
                    }
                    $main_info[$_][1] += ($2 - $main_info[$_][3]);$main_info[$_][2] += ($1 - $main_info[$_][4]);
                    $main_info[$_][3] = $2;$main_info[$_][4] = $1;
                }
            }
        }
        refresh( 1 );
    }
     
    sub popup {
        $mw->messageBox( -default => 'Ok',
                          -message => 'Nouveau message sur le forum '.$main_info[$_[0]][0],
                          -title => 'Nouveau message',
                          -icon => 'info',
                          -type => 'Ok')
    }


    [EDIT] Petites amélioration cosmétiques
    --
    Jedaï

+ Répondre à la discussion
Cette discussion est résolue.
Page 2 sur 2 PremièrePremière 12

Discussions similaires

  1. [Conseil] Scripts de Forum
    Par kirsoul dans le forum EDI, CMS, Outils, Scripts et API
    Réponses: 5
    Dernier message: 21/11/2005, 17h07
  2. Réponses: 7
    Dernier message: 08/07/2004, 14h47

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo