|
{ 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.