Re: Proposal: org-protocol handles redirects (finally)

[Carsten Dominik <carsten.dominik@gmail.com>]

Applied, thanks.

- Carsten

On Nov 13, 2009, at 6:56 PM, Sebastian Rose wrote:

> Hi,
>
>
> here is a little patch for org-protocol.el, I always wanted to  
> have.  It
> enhances `org-protocol-open-source' to handle rewritten URLs to some
> extend.
>
> I tested it successfully with my projects here and on the web and it's
> exactly what I've been missing.
>
> If you find it breaks something, or know it how it could be  
> implemented
> better, report back.
>
>
>
> * This is how it works:
>
>  Each project in `org-protocol-project-alist' may now have a new
>  element `:rewrites'. `:rewrites' is a list of cons cells, that maps
>  regular expressions to relative paths.
>
>
>
> * Example:
>
>  (setq org-protocol-project-alist
>      '(("http://fairposter.de/"
>         :base-url "http://example-web-shop.de/"
>         :working-directory "/path/to/working/directory/"
>         :online-suffix ".php"
>         :working-suffix ".php"
>         :rewrites (("example-web-shop.de/cars/" . "products.php")
>                    ("example-web-shop.de/$" . "index.php")
>                    ))
>
>         ;; .... more projects here
>         ))
>
>
>  Today, if I visit http://www.example-web-shop.de/, the URL would
>  not match a path to any of the files below my working directory.
>
>  Tomorrow, /path/to/working/directory/index.php is opened, because  
> there's
>  a matching rewrite.
>
>
>  Today, a rewritten URL like
>    http://example-web-shop.de/cars/lamborghini/Gallardo_LP560-4_MY09
>  would not match a path to any of the files below my working
>  directory, because URLS like `..../cars/' would be rewritten on the
>  server and served through http://example-web-shop.de/products.php.
>
>  Tomorrow, that URL will be mapped to
>  /path/to/working/directory/products.php, because there's a matching
>  rewrite defined.
>
>
>
> Best wishes
>
>   Sebastian
>
>
> diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el
> index 30d2dd3..a2bc6af 100644
> --- a/lisp/org-protocol.el
> +++ b/lisp/org-protocol.el
> @@ -185,6 +185,8 @@ Possible properties are:
>                        Last slash required.
>   :working-directory - the local working directory. This is, what  
> base-url will
>                        be replaced with.
> +  :redirects         - A list of cons cells, each of which maps a  
> regular
> +                       expression to match to a path relative  
> to :working-directory.
>
> Example:
>
> @@ -198,7 +200,12 @@ Example:
>           :online-suffix \".html\"
>           :working-suffix \".org\"
>           :base-url \"http://localhost/org/\"
> -          :working-directory \"/home/user/org/\")))
> +          :working-directory \"/home/user/org/\"
> +          :rewrites ((\"org/?$\" . \"index.php\")))))
> +
> +   The last line tells `org-protocol-open-source' to open
> +   /home/user/org/index.php, if the URL cannot be mapped to an  
> existing
> +   file, and ends with either \"org\" or \"org/\".
>
> Consider using the interactive functions `org-protocol-create' and
> `org-protocol-create-for-org' to help you filling this variable with  
> valid contents."
> @@ -504,10 +511,35 @@ The location for a browser's bookmark should  
> look like this:
>             (let* ((wdir (plist-get (cdr prolist) :working-directory))
>                    (strip-suffix (plist-get (cdr prolist) :online- 
> suffix))
>                    (add-suffix (plist-get (cdr prolist) :working- 
> suffix))
> -                   (start-pos (+ (string-match wsearch f) (length  
> base-url)))
> +		   ;; Strip "[?#].*$" if `f' is a redirect with another
> +		   ;; ending than strip-suffix here:
> +		   (f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f)))
> +                   (start-pos (+ (string-match wsearch f1) (length  
> base-url)))
>                    (end-pos (string-match
> -                             (concat (regexp-quote strip-suffix) "\\ 
> ([?#].*\\)?$") f))
> -                   (the-file (concat wdir (substring f start-pos  
> end-pos) add-suffix)))
> +			     (regexp-quote strip-suffix) f1))
> +		   ;; We have to compare redirects without suffix below:
> +		   (f2 (concat wdir (substring f1 start-pos end-pos)))
> +                   (the-file (concat f2 add-suffix)))
> +
> +	      ;; Note: the-file may still contain `%C3' et al here because  
> browsers
> +	      ;; tend to encode `ä' in URLs to `%25C3' - `%25' being ` 
> %'.
> +	      ;; So the results may vary.
> +
> +	      ;; -- start redirects --
> +	      (unless (file-exists-p the-file)
> +		(message "File %s does not exist.\nTesting for rewritten URLs."  
> the-file)
> +		(let ((rewrites (plist-get (cdr prolist) :rewrites)))
> +		  (when rewrites
> +		    (message "Rewrites found: %S" rewrites)
> +		    (mapc
> +		     (lambda (rewrite)
> +		       "Try to match a rewritten URL and map it to a real file."
> +		       ;; Compare redirects without suffix:
> +		       (if (string-match (car rewrite) f2)
> +			   (throw 'result (concat wdir (cdr rewrite)))))
> +		     rewrites))))
> +	      ;; -- end of redirects --
> +
>               (if (file-readable-p the-file)
>                   (throw 'result the-file))
>               (if (file-exists-p the-file)
> @@ -596,7 +628,7 @@ most of the work."
>   "Create a new org-protocol project interactively.
> An org-protocol project is an entry in `org-protocol-project-alist'
> which is used by `org-protocol-open-source'.
> -Optionally use project-plist to initialize the defaults for this  
> worglet. If
> +Optionally use project-plist to initialize the defaults for this  
> project. If
> project-plist is the CDR of an element in `org-publish-project- 
> alist', reuse
> :base-directory, :html-extension and :base-extension."
>   (interactive)
> @@ -632,7 +664,7 @@ project-plist is the CDR of an element in `org- 
> publish-project-alist', reuse
>            (concat "Extension of editable files ("working-suffix"): ")
>                    working-suffix nil working-suffix t))
>
> -    (when (yes-or-no-p "Save the new worglet to your init file? ")
> +    (when (yes-or-no-p "Save the new org-protocol-project to your  
> init file? ")
>       (setq org-protocol-project-alist
>             (cons `(,base-url . (:base-url ,base-url
>                                  :working-directory ,working-dir
> _______________________________________________
> Emacs-orgmode mailing list
> Remember: use `Reply All' to send replies to the list.
> Emacs-orgmode@gnu.org
> http://lists.gnu.org/mailman/listinfo/emacs-orgmode

- Carsten