quinta-feira, 18 de novembro de 2010

accents-substitute

Seguidamente tenho a necessidade de remover acentos de textos em português. Há umas semanas fiz uma extensão para Chicken chamada accents-substitute substituir caracteres acentuados pelos correspondentes sem acento (ou com entidades de HTML).

A extensão aceita textos em Latin1 (ISO-8859-1) ou UTF-8, havendo um módulo para cada codificação, ambos provendo o mesmo procedimento: accents-substitute (nome inspirado em string-substitute, da extensão regex).

Para facilitar o uso no dia-a-dia, fiz um pequeno script que usa o procedimento {{accents-substitute}}. Abaixo estão alguns exemplos de uso:
$ accents-substitute --help
Usage: accents-substitute [ --encoding= ] [ --mode= ] [ input file ]

Default values:
mode: ascii
encoding: utf8
$ cat lisp-br
Lisp-BR é um projeto que tem por objetivo divulgar linguagens de
programação da família Lisp no Brasil e formar uma comunidade de
usuários que tenham vontade de aprender não só uma nova forma de
programar, mas também uma nova maneira de pensar!
$ cat lisp-br | accents-substitute 
Lisp-BR e um projeto que tem por objetivo divulgar linguagens de
programacao da familia Lisp no Brasil e formar uma comunidade de
usuarios que tenham vontade de aprender nao so uma nova forma de
programar, mas tambem uma nova maneira de pensar!
$ accents-substitute --mode=html lisp-br
Lisp-BR é um projeto que tem por objetivo divulgar linguagens de
programação da família Lisp no Brasil e formar uma comunidade de
usuários que tenham vontade de aprender não só uma nova forma de
programar, mas também uma nova maneira de pensar!


O código da ferramenta de linha de comando está a seguir:
#!/bin/sh
#| -*- scheme -*-
exec csi -s $0 "$@"
|#

(use
(rename
accents-substitute-latin1
(accents-substitute accents-substitute-latin1))
(rename
accents-substitute-utf8
(accents-substitute accents-substitute-utf8)))

(use posix regex (srfi 1 13))

(define (command-line-argument option args)
;; Return the argument associated to the command line option OPTION
;; in ARGS or #f if OPTION is not found in ARGS or doesn't have any
;; argument.
(let ((val (any (cut string-match (string-append option "=(.*)") <>) args)))
(and val (cadr val))))

(define (usage #!optional exit-code)
(print "Usage: " (pathname-strip-directory (program-name))
" [ --encoding=<utf8|latin1> ] [ --mode=<ascii|html> ] [ input file ]")
(print "\nDefault values:\n"
" mode: ascii\n"
" encoding: utf8")
(when exit-code (exit exit-code)))

(let* ((args (command-line-arguments))
(mode (command-line-argument "--mode" args))
(encoding (command-line-argument "--encoding" args))
(paramless-args (remove (cut string-prefix? "--" <>) args))
(accents-substitute accents-substitute-utf8))

(when (or (member "-h" args) (member "--help" args))
(usage 0))

(when (and encoding (not (member encoding '("utf8" "latin1"))))
(print "'" encoding "' is not a valid encoding.")
(exit 1))

(when (and mode (not (member mode '("ascii" "html"))))
(print "'" mode "' is not a valid mode.")
(exit 1))

(when (equal? encoding "latin1")
(set! accents-substitute accents-substitute-latin1))

(let ((port (if (null? paramless-args)
(current-input-port)
(open-input-file (car paramless-args)))))
(let loop ()
(let ((line (read-line port)))
(unless (eof-object? line)
(print (accents-substitute line mode: (and mode (string->symbol mode))))
(loop))))
(unless (null? paramless-args)
(close-input-port port))))


Adicionei este exemplo de aplicação à seção Examples da documentação de accents-substitute.