{ open Lexing exception Error of string let count = ref 0 } (* liaison de motif, évite de répéter la définition des blancs partout *) let blank = [' ''\n''\t'] (* Entrée principale de l'analyseur *) rule main = parse | '<' (* début de balise, à afficher! *) {count := !count + 1 ; Printf.printf "%03i: " !count ; print_string "<" ; intag lexbuf ; main lexbuf} | "<!--" (* début de commentaire, à oublier *) {incomment lexbuf} | _ (* à oublier *) { main lexbuf } | eof {()} (* Afficher les balises *) and intag = parse | '>' { print_endline ">" ; () } (* c'est fini, (avec retour à la ligne) *) | _ {let lxm = lexeme lexbuf in print_string lxm ; intag lexbuf} | eof {raise (Error ("Balise pas fermée"))} (* Oublier les commentaires *) and incomment = parse | "-->" {main lexbuf} | _ {incomment lexbuf} | eof {raise (Error ("Commentaire pas fermé"))} { |
count
(de type int
ref
) est défini dans le
prélude et incrémenté à chaque découverte de « <
» dans
main.
{ open Lexing exception Error of string let chop s = String.sub s 1 (String.length s - 2) let cons x xs = match x with | Some x -> x::xs | _ -> xs } let blank = [' ''\n''\t'] (* Mission : chercher les balises <A... et <IMG *) rule main = parse | "<!--" (* début de commentaire, à oublier *) {incomment lexbuf ; main lexbuf} | '<' blank* ['a''A'] {let url = get_href lexbuf in cons url (main lexbuf)} | '<' blank* ['i''I']['m''M']['g''G'] {let url = get_src lexbuf in cons url (main lexbuf)} (* pour les balises ambigües, peu probables, mais bon *) | '<' blank* ['a'-'z''A'-'Z']+ {end_tag lexbuf ; main lexbuf} | _ {main lexbuf} | eof {[]} (* Mission : chercher un attribut href *) and get_href = parse (* Attibuts HREF *) | ['h''H']['r''R']['e''E']['f''F'] blank* '=' blank* {let r = get_arg lexbuf in end_tag lexbuf ; Some r} (* sauter les autres attributs, avec valeur *) | ['a'-'z''A'-'Z']+ blank* '=' blank* {let _ = get_arg lexbuf in get_href lexbuf} (* Et sans valeur *) | ['a'-'z''A'-'Z']+ {get_href lexbuf} | '>' {None} | blank+ {get_href lexbuf} | eof {raise (Error "Balise A non terminée")} | "" {raise (Error "Syntaxe des attributs dans A")} (* Mission : chercher un attribut src *) and get_src = parse (* Attibut SRC *) | ['s''S']['r''R']['c''C'] blank* '=' blank* {let r = get_arg lexbuf in end_tag lexbuf ; Some r} (* sauter les autres attributs, avec valeur *) | ['a'-'z''A'-'Z']+ blank* '=' blank* {let _ = get_arg lexbuf in get_src lexbuf} (* Et sans valeur *) | ['a'-'z''A'-'Z']+ {get_src lexbuf} | '>' {None} | blank+ {get_src lexbuf} | eof {raise (Error "Balise IMG non terminée")} | "" {raise (Error "Syntaxe des attributs dans IMG")} (* Mission : renvoyer une valeur d'attribut *) and get_arg = parse | ('\"'[^'\"']*'\"') | ('\''[^'\'']*'\'') {let lxm = lexeme lexbuf in chop lxm} | ['a'-'z''A'-'Z''0'-'9''-''_'':''.']+ {let lxm = lexeme lexbuf in lxm} | "" {raise (Error ("Argument incorrect"))} (* Mission : chercher le « > » final, à l'interieur des balises *) and end_tag = parse | '>' {()} (* À tout hasard, si jamais « > » se trouvait dans un argument cité ! Mais ça doit être interdit. *) | ('\"'[^'\"']*'\"') | ('\''[^'\'']*'\'') | _ {end_tag lexbuf} | eof {raise (Error ("Balise non terminée"))} (* Mission : sortir des commentaires *) and incomment = parse | "-->" {()} | _ {incomment lexbuf} | eof {raise (Error ("Commentaire pas fermé"))} |
val main : Lexing.lexbuf -> string list val get_href : Lexing.lexbuf -> string option val get_src : Lexing.lexbuf -> string option val get_arg : Lexing.lexbuf -> string val end_tag : Lexing.lexbuf -> unit |
get_href
et get_src
rendent la
référence distance compris dans les balises <A ..>
ou
<IMG ...>
.
En fait c'est une option de chaîne qui est rendue pour tenir compte du
fait que ces balises peuvent ne pas contenir de référence distante.
Considérer par exemple <A NAME="foo">
.
Enfin l'analyseur end_tag
est appelé pout trouver la fin des
balises et ne renvoie rien.main
, (ainsi que get_href
et
get_src
), reconnaissent d'autre noms de balises (d'attributs)
afin de traiter le cas en fait peu probable où le nom recherché est
préfixe d'un autre nom.
Considérer par exemple une improbable balise <IMGFOO>
.
Il peut se faire que considérer les balises comme uniquement formées
de lettres soit un peu naïf, mais ça suffit bien ici.<
» et
le nom de la balise.<A
...est tout simplement répérée
par '<' blank* ['a''A']
!
On pourrait craindre une erreur, si par exemple il existait une balise
<AGAGA
....
Mais en fait, il n'y a pas d'erreur possible en raison de la presence motif
'<' blank* ['a'-'z''A'-'Z']*
qui filtrera <AGAGA
du fait
de la règle du lexème le plus long.\(\([^:/?#]+\):\)?\(//\([^/?#]*\)\)?\([^?#]*\)\(\?\([^#]*\)\)?\(#\(.*\)\)?Cette expression est assez difficilement lisible et le devient encore plus si on remplace «
\(
» et « \)
»
par « \\(
» et « \\)
» pour en faire une chaîne Caml,
signifiant
exactement l'expression ci-dessus (rappelons que pour mettre
« \
» dans une chaîne, il faut écrire « \\
».
(([^':''/''?''#']+ as scheme) ':')? ("//" ([^'/''?''#']* as authority))? ([^'?''#']* as path) ('?' ([^'#']* as query))? ('#' (_ * as fragment))? |
(([^':''/']+ as scheme) ':')? ("//" ([^'/']* as authority))? (_* as path) |
\(\([^:/]+\):\)?\(//\([^/]*\)\)?\(.*\)Et ça ne sera pas trop faux.
\(\([^:/?#]+\):\)?
» qui sert à extraire le
scheme, c'est à dire le protocole.
Un scheme est reconnu comme une suite non-vide de caractères
différents de
« :
», « /
», « ?
» et « #
»,
obligatoirement suivie du caractère « :
».
Relativement à l'url complète, le scheme est optionnel.
En outre, certaines sous-chaînes sont identifiées par les parenthèses
« \(
»... « \)
» et on peut les récupérer, une fois
le filtrage effectué, par l'appel Str.matched_group
i,
où i correspond au numéro d'ordre des parenthèses ouvrantes.
Dans notre cas, le groupe numéro 2 est le nom du protocole et le
groupe numéro 1 est le nom du protocole plus le caractère
« :
» final."\("
» est illégal...Il faut écrire « "\\("
» (c'est à dire citation de blackslash
suivi de « ( »), c'est très lourd.# ./url -v index.html .... URL: url.mll scheme: ``'' authority: ``'' path: ``url.mll'' query: ``'' fragment: ``'' URL: http://www.ics.uci.edu/pub/ietf/uri/rfc2396.txt scheme: ``http'' authority: ``www.ics.uci.edu'' path: ``/pub/ietf/uri/rfc2396.txt'' query: ``'' fragment: ``'' ...
Ce document a été traduit de LATEX par HEVEA.