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. #1
    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 [web] [script] surveillance forum developpez.
    Bonjour à tous perliennes & perliens.

    Sous phpbb on peut surveiller un topic, à chaque nouvelle réponse on recoit un mail disant "blabla" a répondu à votre message.

    Dans le même genre d'idèe je souhaite ecrire un petit script qui à interval régulier irait voir si il y a de nouveau topic dans une sous partie du forum.

    Par exemple, surveiller la creation des topics de la section perl.

    Auriez vous une méthodologie à me proposer pour le faire ? Faut donc prendre en compte le critere date du topic sujet ... envoi d'un mail ... ce genre de chose....

    j'attend vos remarques et vos idees.

    Si c'est pas clair je completerais.

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

  2. #2
    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
    Voici une solution simple et facile à mettre en oeuvre (je n'ai même pas utilisé de parseur HTML) :
    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
     
    #! /usr/bin/perl
    use strict;
    use warnings;
     
    use LWP::UserAgent;
    use locale;
     
    my $ua = LWP::UserAgent->new;
    #ua de IE6
    $ua->agent("Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)" . $ua->agent);
     
    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 $forum;
    my $messages = 0;
    my $topics = 0;
     
    while(1) {
        print scalar localtime(), "\n";
        print "Send request\n";
        my $res = $ua->request($req);
     
        if ($res->is_success) {
            $forum =$res->content;
            print "Success of the request\n";
            print "Success of the regex\n" if $forum =~ m|PERL .+?
                        <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                        <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                        |ixms;
            print "Nouveaux messages sur le forum Perl !!\n" if $2 > $messages;
            print "Nouveaux topics !!\n" if $1 > $topics;
            ($topics, $messages) = ($1,$2);
        }
        else {
            print "Error: " . $res->status_line . "\n";
        }    
     
        sleep 300;
    }
    [EDIT] Je confirme que ça marche, par exemple là il vient de m'informer du fait qu'il y avait un nouveau message (le mien )


    --
    Jedaï

  3. #3
    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
    En tant qu'amélioration très pratique au concept, on peut juste rajouter un son à émettre lorsque la vérification révèle l'arrivée de nouveaux messages, évitant ainsi d'avoir à reconsulter sa console régulièrement :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    print "\aNouveaux messages sur le forum Perl !!\n" if $2 > $messages;
    Ici j'utilise la cloche système, c'est un son bien reconnaissable donc assez adapté, mais on peut envisager de signaler visuellement l'arrivée d'un nouveau message avec PerlTk par exemple.

    --
    Jedaï

  4. #4
    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
    Excuse moi, peux tu expliquer un peu plus en detail la partie regex... Quelle info cherches tu ?

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
            print "Success of the regex\n" if $forum =~ m|PERL .+?
                        <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                        <td [^>]*> \s* <span [^>]*> \s* (\d+) \s* </span> \s* </td> \s*
                        |ixms;
    Cette partie là je la comprend pas trop...
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  5. #5
    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
    Si tu regardes le source de la page d'accueil du forum, tu constateras que cette regex me permet de récupérer le nombre de message dans le forum Perl, ainsi que le nombre de topics. D'où la solution ! :-) (Tu pourrais aussi regarder la date du dernier message mais les manipulations de date m'ont toujours horripilé... )
    (nouveau message repéré grâce à ce script !!)
    --
    Jedaï

  6. #6
    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
    haaa je mate la source de ma page ! je comprenais pas...

    Ok c'est trop cool. Je vais faire la partie qui envoi un mail et qui indique les nouveaux sujets ...

    Y a t'il moyen de lancer un script perl dans la taskbar de windows ? (là je suis feignant ... rapide recherche ....2 s Non je trouve rien )...

    Au pire vais me faire une tite interface graphique mais bon... déjà ca marche Merci beaucoup donc...
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  7. #7
    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
    Bonjour,

    Ce genre de script sont tres bien. Cependant, il ne faut pas en abuser en faisant des verifications trop souvent. (c'est toujours mieux que d'utiliser la fonction mail du forum)

  8. #8
    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
    Oui bien sûr, mais demander une fois la page d'accueil toutes les 4 minutes ne risque pas de surcharger le serveur, non ?
    Par ailleurs j'ai essayé de faire un truc un peu plus complexe, je vais corriger la synchronisation et il y a quelques problèmes encore, mais les bases sont en places :
    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
     
    #! /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)";
    }
    Je suis ouvert à toute suggestion.
    (surtout dans le domaine de la synchronisation, je n'ai pas tellement l'habitude des threads)

    --
    Jedaï

  9. #9
    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
    Ca marche pas mal (enfin le mode "texte", parce que j'ai rien fait d'autre pour l'instant, le mode bavard aussi, mais il n'est pas des plus intéressants...), par contre si quelqu'un voulait faire la partie graphique sur le même principe que la partie textuelle (autrement dit avec un bouton pour remettre à 0 les compteurs et un pour quitter, ainsi qu'un pour fermer juste la fenètre).

    --
    Jedaï

  10. #10
    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
    J'ai (sous windows) un drole de phenomene, la ligne nouveau message est atteinte de tremblements .... Et je peux pas quitter en tapant 'q'...

    Peux tu annoter ton code s'il te plait ? Quand on est pas dans l'move c'est dur de suivre Je crois que j'ai eu une excellente idée avec ce sujet et j'ai trouvé un excellent codeur...

    (stu veux j'ai des projets l'année prochaine )

    Demain je vais m'occuper de l'interface graphique si tu veux. Sinon toujours la question sous windows, on peut avoir le programme en barre des taches avec perl ?

    Amicalement, Choupi.
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  11. #11
    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
    En fait le "Taper 'q' pour quitter." est un peu faux : il faut valider après. Et la fermeture ne s'effectue pas toujours instantanément, vu que la synchronisation est toujours assez boiteuse...
    Par ailleurs, ce n'est pas indiqué, mais si tu tapes juste sur enter, tu réinitialise le compteur.
    Voilà un code un peu corrigé :
    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
     
    #! /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' et valider 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;
        }
    }
     
    $mainthread->join();
    $graphthread->join() if $opts{g};
    $textthread->join() if $opts{t};
     
     
     
     
    # DEFINITION DES THREADS
     
    sub maj () {
        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);
     
            for (my $i = 0; $i < $opts{i}; $i += 10) {
                sleep 10; last MAJ if $ipt == -1;
            }
        }
        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.");
        TEXT : while (1) {
            {
                lock $ipt;
                last TEXT 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 10;
        }
        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)";
    }
    Maintenant le programme quitte "proprement", autrement dit il récupère les threads qui traînent avant d'expirer. En contrepartie, il se ferme en 10 secondes maximum, pas instantanément comme avant, mais bon... Va falloir que je planche sur la synchro, sérieusement !!

    --
    Jedaï

  12. #12
    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
    C'est deja beaucoup mieux, et meme si la fermeture n'est pas immediate ca marche d'enfer ! (voir tes MP au passage).

    J'ai une question pour l'envoi des mails, j'utilise le module smtp (classique) mais il n'y a pas d'identification au niveau des serveurs smtp ? (je suis chez wanadoo ... peut etre accepte t'il mes envois car je me connecte de chez moi ... ? mais si je me connecte d'ailleurs, ca marchera aussi ?).

    Donc interface :

    ¤ choix du forum
    ¤ frequence de renouvellement (avec limite pour pas abuser)
    ¤ ajout fonction mail ....
    ¤ affichage joli
    ¤ icone dans la barre des taches ? (en perl j'ai pas encore vu ca).

    D'autres idees ?
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  13. #13
    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
    Ok, les deux premiers points sont déjà faits (sans limite pour l'instant, mais je compte sur l'intelligence des gens, de toutes façon les vilains pirates ont beaucoup mieux pour faire joujou), et j'ai maintenant une synchro dix fois meilleure, avec terminaison du programme dans les trois secondes et mise à zéro immédiate, enfin le système est beaucoup mieux conçu !
    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
    199
    200
    201
     
    #! /usr/bin/perl
    use strict;
    #~ use warnings;
     
     
     
    # MODULES OBLIGATOIRES
     
    use Tk;
    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 graph (); # mode graphique -g
    sub clock (); # 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('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' et valider pour quitter.\n";
     
    my $mqueue : shared = Thread::Queue->new;
     
    my $gqueue : shared;my $tqueue : shared;
    $gqueue = Thread::Queue->new if $opts{g};
    $tqueue = Thread::Queue->new if $opts{t};
     
    my $mainthread = threads->create( "maj" );
     
     
    my ($graphthread, $textthread);
    $graphthread = threads->create( "graph" ) if $opts{g};
    $textthread = threads->create( "text" ) if $opts{t};
     
     
    my $clockthread = threads->create( "clock" );
     
    if( not $opts{g} ) { 
        while( <STDIN> ){
            if(/^q$/) {
                $ipt = 1;
                $gqueue->enqueue( 0 ) if $opts{g};
                $tqueue->enqueue( 0 ) if $opts{t};
                $mqueue->enqueue( 0 );
                last;
            }
            $gqueue->enqueue( 2 ) if $opts{g};
            $tqueue->enqueue( 2 ) if $opts{t};
        }
    }
     
    $mainthread->join();
    $graphthread->join() if $opts{g};
    $textthread->join() if $opts{t};
    $clockthread->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;
            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);
     
     
     
            while(1) {
                $mclock = $mqueue->dequeue();
                last MAJ if not $mclock;
                $sleeptime += 10;
                last if $sleeptime >= $opts{i};
            }
        }
        return;
    }
     
    sub graph () {
        my ($gmess, $gtop) = ($messages, $topics);
    }
     
    sub text () {
        my $tclock;
        my ($tmess, $ttop, $time) = ($messages, $topics, scalar localtime());
        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));
                $ipt = 0;
            }
            $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 clock () {
        while (1){
            last if $ipt;
            $mqueue->enqueue( 1 );
            sleep 3;
            last if $ipt;
            $gqueue->enqueue( 1 ) if $opts{g};
            sleep 2;
            last if $ipt;
            $tqueue->enqueue( 1 ) if $opts{t};
            sleep 2;
        }
    }
     
     
     
    # 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)";
    }
    Je vais regarder les autres points, mais je ne sais pas trop comment gérer cette histoire d'email : les envoyer dès qu'il y a un nouveau message ? Ca risque de devenir catastrophique en cas de folie du forum comme il y a peu, non ?

    --
    Jedaï

  14. #14
    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
    Fonction mail je vais la faire ... Je pense mail lorsque 5 nouveaux messages ? ou un truc du genre... Et ca sera optionnel vu que l'affichage suffit.

    Je vais me concentrer sur l'interface... Je vais aussi tester et dissequer ton code. A tout
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  15. #15
    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
    Oui bien sûr, mais demander une fois la page d'accueil toutes les 4 minutes ne risque pas de surcharger le serveur, non ?
    Oui ca risque pas la. Puis ca evite toujours d'aller sur un topic, revenir sur l'ancienne, aller sur un autre topic,... Ca peut faire gagner du temps.
    Je pense qul'il y a moyen de faire quelque chose de bien en le couplant avec un module gtk.

  16. #16
    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
    Ca peut faire gagner du temps.
    Je pense qul'il y a moyen de faire quelque chose de bien en le couplant avec un module gtk.
    Je suis lancé sur l'api win (win32::Gui) ... J'utilise preferentiellement active perl donc pour moi c'est plus facile. Si je parviens à coupler de manière efficace le code de Jedai à une interface tk / win32Gui dans ce cas je ferais en sorte de produire une version 100% portable.

    Promis on aura un tit script portable !
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  17. #17
    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 Choupi
    Citation Envoyé par nyal
    Ca peut faire gagner du temps.
    Je pense qul'il y a moyen de faire quelque chose de bien en le couplant avec un module gtk.
    Je suis lancé sur l'api win (win32::Gui) ... J'utilise preferentiellement active perl donc pour moi c'est plus facile. Si je parviens à coupler de manière efficace le code de Jedai à une interface tk / win32Gui dans ce cas je ferais en sorte de produire une version 100% portable.

    Promis on aura un tit script portable !
    Un interet de perl est de rendre le truc portable. Alors si oon se met a utiliser des modules non portables... alors qu'il existe tk (que je trouve tres moyen), gtk (beaucoup mieux), wxwidgets (pas essayé),...


  18. #18
    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
    Le petit problème de Gtk, c'est qu'il faut quand même installer Gtk, ce qui n'est pas le cas par défaut sous Windows... Alors que Perl::Tk est disponible par défaut avec ActivePerl et très facilement accessible sous Linux.
    Je peux m'occuper de la partie graphique avec Perl::Tk si vous voulez (de toute façon, il faut que je réorganise un peu le programme, le clock devrait être le thread principal et la gestion de STDIN déporté sur un autre thread).

    (D'un autre côté si tu proposes une version Perl::Gtk, c'est pas moi qui m'en plaindrai !)
    --
    Jedaï

  19. #19
    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
    Yep ben moi j'ai une version sous win ... helas trop de diff avec tk. Petite capture :

    Alors liste des forums... classique:



    Intégration à la barre des taches (admirez la petite icone developpez )



    Ajout sous peu du decompte avant prochaine verification...
    Ajout sous peu des preferences (mais, affichage, frequence verification, petit son ?)....

    Jedai, je n'arrive pas à recuperer la liste des forums avec ta regex... Je trouve pas d'erreur... (je veux les recuperer sous forme de tableau au passage).
    MacOS 10.5 / Ubuntu / C / Python / R
    Pensez au tag résolu

  20. #20
    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
    Le petit problème de Gtk, c'est qu'il faut quand même installer Gtk, ce qui n'est pas le cas par défaut sous Windows... Alors que Perl::Tk est disponible par défaut avec ActivePerl et très facilement accessible sous Linux.
    Je peux m'occuper de la partie graphique avec Perl::Tk si vous voulez (de toute façon, il faut que je réorganise un peu le programme, le clock devrait être le thread principal et la gestion de STDIN déporté sur un autre thread).

    (D'un autre côté si tu proposes une version Perl::Gtk, c'est pas moi qui m'en plaindrai !)
    Je n'aime pas specialement tk (car j'ai toujours eu des problemes avec) mais c'est toujours mieux que un module non portable .

+ Répondre à la discussion
Cette discussion est résolue.
Page 1 sur 2 12 DernièreDernière

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