Difficulté première utilisation XML::Twig pour parsing fichier XML

Version imprimable

Bonjour,

notre système de tickets (Redmine) propose une API me servant les informations au format XML.
Ci-après, un exemple édulcoré de ces données :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
<?xml version="1.0" encoding="UTF-8"?>
<issues total_count="2260" offset="0" limit="100" type="array">
  <issue>
    <id>9399</id>
    <project id="40" name="PE (Prestations Espèces)"/>
    <tracker id="15" name="DT (Demande de Travaux)"/>
    <status id="3" name="Réalisé"/>
  </issue>
  <issue>
    <id>9398</id>
    <project id="63" name="-- DTA"/>
    <tracker id="15" name="DT (Demande de Travaux)"/>
    <status id="3" name="Réalisé"/>
  </issue>
</issues>

Je souhaite parser ce fichier pour créer un hash qui sera traité par la suite :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
  %h
  {
          9399 => {
            project => {
               id   => 40
               name => 'PE (Prestations Espèces)'
            }
            tracker => {
               id   => 15
               name => 'DT (Demande de Travaux)'
            }
          }
          9398 => {
            project => {
               id   => 63
               name => '-- DTA'
            }
            tracker => {
               id   => 15
               name => 'DT (Demande de Travaux)'
            }
          }
  }

Je ne suis pas un spécialiste du XML et c'est la 1ère fois que j'ai à parser une telle structure.
J'ai choisi le module XML::Twig, lu le tuto sur developpez.com et celui sur http://xmltwig.org mais suis un peu perdu, n'ayant pas beaucoup de temps devant moi.

Mon script de test est :

Code:

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
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use XML::Twig;
use feature 'say';
 
my $xml_file = shift;
 
my $twig = new XML::Twig (
    twig_handlers =>
      { id      => \&get_issue,
        project => \&get_project_atts,
      }
);
 
$twig->parsefile( $xml_file);
my $root =$twig->root;        # racine de twig (issues)
 
my @issues = $root->children; # liste des ticket (issue)
 
foreach my $issue ( @issues ) {
    say "From pgm - Issue    : ", $issue->field('id');
}
 
sub get_issue {
    my ( $t, $elt ) = @_;
    # KO - my $issue_id = $elt->first_child('issue')->field('id');
    # my $issue_id = $elt->first_child('id');
    # say "From handler - Issue id : $issue_id";
}
 
sub get_project_atts {
    my ( $t, $elt ) = @_;
 
    my $project_id   = $elt->{'att'}->{'id'};
    my $project_name = $elt->{'att'}->{'name'};
    say "From handler - Project id : $project_id _ Project name : $project_name";
}

Il produit la sortie :

Code:

1
2
3
4
From handler - Project id : 40 _ Project name : PE (Prestations Esp▒ces)
From handler - Project id : 63 _ Project name : -- DTA
From pgm - Issue    : 9399
From pgm - Issue    : 9398

J'arrive à récupérer l'id du ticket après le parsing (boucle 'foreach my $issue', mais pas dans la fonction get_issue.
Si j'ai bien compris, les handlers sont appellés à chaque fois que le tag est rencontré, me permettant de retrouver les attributs ; par contre la bouche 'foreach' s'exécute après le parsing.
Je n'arrive pas non plus à récupérer l'id du ticket dans le get_project_atts

Je sèche lamentablement et ai du mal à voir comment lier tout cela pour alimenter le hash.

Merci pour votre aide.

05/10/2018, 17h01
ptonnerre

Je me suis penché sur le module XML::LibXML avec ce tuto et ai trouvé une solution simple à mon problème.

Je ne suis plus au travail et publierai la suite lundi prochain.

La solution utilisant XML::LibXML :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#!/usr/bin/env perl
use strict;
use warnings;
use XML::LibXML;
use feature 'say';

my $filename  = shift;

my $dom = XML::LibXML->load_xml(location => $filename);

foreach my $issue ($dom->findnodes('//issue')) {   # liste des issues en utilisant un chemin XPath => tous les noeuds issue au niveau 2 depuis la racine
    say 'Issue    ', $issue->findvalue('./id');              # récupération du contenu du champ id du noeud courant
    say 'Project  ', $issue->findvalue('./project/@id'), ' ', $issue->findvalue('./project/@name');  # récupération attributs id et name en utilisant la syntaxe @<att> du niveau courant du champ project
    say 'Tracker  ', $issue->findvalue('./tracker/@id'), ' ', $issue->findvalue('./tracker/@name');  #                                  ''
}

08/10/2018, 19h52
Lolo78

Merci pour le partage, ce code pourra sans doute servir à d'autres. :plusser:
12/10/2018, 21h31
ptonnerre

Bonsoir,

je progresse dans la réalisation de ce projet. Les données issues de l'API se chargent dans une structure de données en mémoire. Je commence à penser à la suite : avez-vous des conseils à me donner sur le choix de modules me permettant de réaliser des images de statistiques à partir de ces données à insérer dans mon tableau de bord ?

Merci
15/10/2018, 18h38
djibril

Bonjour,

Ce tutoriel pourra t'aider : Perl et les fichiers XML.
18/10/2018, 19h24
ptonnerre

J'arrive au bout de mon développement grâce à l'utilisation de XML::LibXML et GD::Graph.
Si cela intéresse quelqu'un, je pourrais publier la partie de code utilisant ce dernier.

ps : les forums Perl sont bien calmes ces temps-ci, tout le monde fait du Python ? 8O
20/10/2018, 23h16
Lolo78

Citation:

Envoyé par ptonnerre

J'arrive au bout de mon développement grâce à l'utilisation de XML::LibXML et GD::Graph.
Si cela intéresse quelqu'un, je pourrais publier la partie de code utilisant ce dernier.

Oui, bien sûr, c'est toujours intéressant de voir du code fait pour une utilisation réelle comme celle-ci.

Citation:

Envoyé par ptonnerre

ps : les forums Perl sont bien calmes ces temps-ci.

Oui, c'est malheureusement vrai.
:(

1 pièce(s) jointe(s)

Uutilisation XML::LibXML et GD::Graph pour parsing fichier XML et génération graphique

Pour clore cette discussion, ci-après la partie de code utilisant le module GD::Graph :

Code:

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
    # chargement des données
    my ( @aamm, @aamm_fmt );             # abcisses  => périodes
    my ( @dls, @dts, @incs ) ;           # ordonnées pour stats nb tickets     => nombre de DL, DT et incidents de production
    my ( @dls_tp, @dts_tp, @incs_tp ) ;  # ordonnées pour stats nb temps passé =>                   ''
 
    foreach my $tms ( sort keys(%{$r_h->{'compteurs'}->{'mensuels_categ'}}) ) {
        push @aamm, $tms;
 
        my $dl    = 'DL (Demande de Livraison)';
        my $value = exists ( $r_h->{'compteurs'}->{'mensuels_categ'}->{$tms}->{$dl} ) ? $r_h->{'compteurs'}->{'mensuels_categ'}->{$tms}->{$dl} : undef;
        push @dls, $value;
 
        $value = exists ( $r_h->{'compteurs'}->{'mensuels_categ_times'}->{$tms}->{$dl} ) ? $r_h->{'compteurs'}->{'mensuels_categ_times'}->{$tms}->{$dl} : undef;
        push @dls_tp, $value;
 
        my $dt = 'DT (Demande de Travaux)';
        $value = exists ( $r_h->{'compteurs'}->{'mensuels_categ'}->{$tms}->{$dt} ) ? $r_h->{'compteurs'}->{'mensuels_categ'}->{$tms}->{$dt} : undef;
        push @dts, $value;
 
        $value = exists ( $r_h->{'compteurs'}->{'mensuels_categ_times'}->{$tms}->{$dt} ) ? $r_h->{'compteurs'}->{'mensuels_categ_times'}->{$tms}->{$dt} : undef;
        push @dts_tp, $value;
 
        my $inc = 'Incident de production';
        $value = exists ( $r_h->{'compteurs'}->{'mensuels_categ'}->{$tms}->{$inc} ) ? $r_h->{'compteurs'}->{'mensuels_categ'}->{$tms}->{$inc} : undef;
        push @incs, $value;
 
        $value = exists ( $r_h->{'compteurs'}->{'mensuels_categ_times'}->{$tms}->{$inc} ) ? $r_h->{'compteurs'}->{'mensuels_categ_times'}->{$tms}->{$inc} : undef;
        push @incs_tp, $value;
    }
 
    @aamm_fmt = map {$_ =~ s{(\d\d\d\d)(\d\d)}{$2/$1} ; $_} @aamm;
 
    my @legends = ( 'DL', 'DT', 'Incidents de production');
 
    my $chart = GD::Graph::lines->new(1200,600) or die GD::Graph::lines->error;;
 
    $chart->set(
        # mémo couleurs
        # white, lgray, gray, dgray, black, lblue, blue, dblue, gold, lyellow, yellow, dyellow, lgreen, green, dgreen, lred, red, dred, lpurple, purple, dpurple, lorange, orange, pink, dpink, marine, cyan, lbrown, dbrown.
        x_label           => outlook_encode ('Année mois'),
        x_label_position  => 0.5,
        y_label           => outlook_encode ('Nb tickets'),
        title             => outlook_encode ('Redmine - Statistiques mensuelles - Nombre de tickets par tracker'),
        bgclr             => 'white',
        fgclr             => 'blue',
        boxclr            => 'lgray',
        show_values       => 'true',
        x_long_ticks      => 0,
        y_long_ticks      => 1,
        dclrs             => [qw (lgreen lblue lred)],
        transparent       => 0,
        x_labels_vertical => 0,
        line_width        => 3,
 
    ) or die $chart->error;
 
    $chart->set_legend(@legends);
 
    my $plot = $chart->plot([ [ @aamm_fmt ],
                              [ @dls  ],
                              [ @dts  ],
                              [ @incs ],
                           ]) or die $chart->error;
 
    my $file = $ref_h_env->{'img_per_tickets'};
    open ( my $out, '>', $file ) or die "Cannot open '$file' for write: $!";
    binmode $out;
    print $out $chart->gd->png;
    close $out;

et le résultat produit :
Pièce jointe 421502