;;; pom --- Utility functions for dealing with maven project.xml files

;; Copyright (C) 2005 Ole Arndt

;; Author: Ole Arndt <ole at sugarshark dot com>
;; Maintainer: Ole Arndt <ole at sugarshark dot com>
;; Keywords: development, java, jdee, maven
;; Time-stamp: Thu Nov 17 14:36:08 2005
;; Version: 0.5
;; X-URL: http://sugarshark.com/elisp/mylisp/pom.el

;; This file is *NOT* part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 2, or (at your option) any later
;; version.

;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
;; more details.

;; You should have received a copy of the GNU General Public License along with
;; GNU Emacs; see the file COPYING.  If not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

;;; Commentary:

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Introduction
;; ------------
;;
;; This package holds some functions to deal with maven POMs
;;
;; It lets you set up you JDE variables from a maven project.xml file.
;; It supports project file inheritance and property substitution from the
;; `project.properties' and `build.properties' files.
;;
;; My typical prj.el for the JDEE looks like this:
;;
;;   (require 'pom)
;;   (let ((pom (pom-read-pom)))
;;     (jde-project-file-version "1.0")
;;     (jde-set-variables
;;      '(jde-javadoc-gen-destination-directory "./target/docs/apidocs")
;;      '(jde-project-name (pom-get-project-id pom))
;;      '(jde-global-classpath (pom-get-classpath pom))))
;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Options
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgroup pom nil
  "Options controlling the maven POM parser
See `pom-read-pom' for more information."
  :group 'tools)

(defcustom pom-maven-local-repository "~/.maven/repository"
  "*Default maven repository directory."
  :type 'directory
  :group 'pom)

(defcustom pom-project-file-name "project.xml"
  "*Default name of a project file."
  :type 'string
  :group 'pom)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POM handling
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (not (fboundp 'string-split))
    (defun string-split (separators string)
      (split-string string separators)))

(defun pom-get-dependency-list (pom)
  "Get dependencies from a POM in the form of a list
of (groupId artifactId version jar type) quintuples."
  (let ((deps (pom-get-tag pom "dependencies")) (result ()))
    (dolist (a (and (listp deps) deps))
      (when a
	(let* ((id (pom-substitute-properties pom (cadr (assoc "id" a))))
	       (groupId (or (pom-substitute-properties pom (cadr (assoc "groupId" a)))
			    (and id (car (string-split ":" id)))))
	       (artifactId (or (pom-substitute-properties pom (cadr (assoc "artifactId" a)))
			       (and id (or (cadr (string-split ":" id)) id))))
	       (version (pom-substitute-properties pom (cadr (assoc "version" a))))
	       (type (or (pom-substitute-properties pom (cadr (assoc "type" a))) "jar"))
	       (jar (or (pom-substitute-properties pom (cadr (assoc "jar" a)))
			(concat artifactId "-" version "."
				(if (string= type "plugin") "jar" type)))))
	  (push (list groupId artifactId version jar type) result))))
    (nreverse result)))

(defun pom-get-tag (pom tag-name)
  "Get the contents of a tag. Returns either a string or a list of children."
  (let ((pp pom)
	(name (if (symbolp tag-name)
		  (symbol-name tag-name)
		tag-name))
	(tag nil)
	(res nil))
    (while (car pp)
      (set 'tag (assoc name (car pp)))
      (if (and tag (nth 1 tag))
	  (if (or (not res) (stringp (car res)))
	      (setq res (cdr tag))
	    (if (not (stringp (nth 1 tag)))
		(setq res (append res (cdr tag))))))
      (set 'pp (cdr pp)))
    (if (stringp (car res))
	(pom-substitute-properties pom (car res)) res)))

(defun pom-substitute-properties (pom string)
  "Substitute all occurances of \\${pom.\\(name\\)} with the result of
`(pom-get-tag pom (quote name))'"
  (when string
    (replace-regexp-in-string "\\${\\(pom\\.\\)*\\([^}]+\\)}"
			      (lambda (str)
				(let ((prop (match-string 2 str)))
				  (or (pom-get-tag pom prop) prop))) string)))

(defun pom-find-pom (&optional pom-file)
  "Find the next project.xml file. Search up the directory tree."
  (interactive)
  (let ((pom (expand-file-name (or pom-file pom-project-file-name))))
    (while (not (file-exists-p pom))
      (if (string= (file-name-directory pom) "/")
	  (error "%s does not exist" (file-name-nondirectory pom))
	(setq pom (expand-file-name (concat "../" (file-name-nondirectory pom))
				    (file-name-directory pom)))))
    pom))
	  
(defun pom-read-pom (&optional file)
  "Read a project.xml file  and its parents into a list of lisp structures.
The properties defined in the project.properties and build.properties
files will be parsed as well.
Properities referenced with a ${property} syntax will be substituted in
both the POM and the propertiy files. This also works for POM values.
Example:
     With ${pom.version} you get the value of the version tag.
     With ${pom.dependencies} you get a sublist of the POM representation.
"
  (let* ((pom-file (expand-file-name (or file (pom-find-pom))))
	 (pom-dir (expand-file-name (file-name-directory pom-file)))
	 (builtin-props `(("properties" ("basedir" ,pom-dir))))
	 (build-props (pom-read-properties
		      (expand-file-name "build.properties" pom-dir)))
	 (project-props (pom-read-properties
			(expand-file-name "project.properties" pom-dir)))
	 (pom (append builtin-props project-props build-props (pom-parse-pom pom-file)))
	 (extend (pom-get-tag pom "extend")))
    (append (and (stringp extend) (pom-read-pom extend)) pom)))


(defun pom-get-project-id (&optional pom)
  "Get the project id. If the optional `pom' parameter is nil,
the project.xml file will be read and parsed."
  (pom-get-tag (or pom (pom-read-pom)) "id"))

(defun pom-get-dependencies (&optional pom repository)
  "Get a list of artifacts this project depends on."
  (interactive)
  (let ((pp (or pom (pom-read-pom)))
	(repo (expand-file-name (or repository pom-maven-local-repository))))
    (mapcar (lambda (a) (concat repo "/" (nth 0 a) "/" (nth 4 a) "s/" (nth 3 a)))
	    (pom-get-dependency-list pp))))

(defun pom-get-dependent-jars (&optional pom repository)
  "Get a list of jars this project depends on."
  (interactive)
  (let ((pp (or pom (pom-read-pom)))
	(repo (expand-file-name (or repository pom-maven-local-repository)))
	(result ()))
    (dolist (a (pom-get-dependency-list pp))
      (if (string= (nth 4 a) "jar")
	  (push (concat repo "/" (nth 0 a) "/" (nth 4 a) "s/" (nth 3 a)) result)))
    (nreverse result)))

(defun pom-get-classpath (&optional pom repository)
  "Get the classpath for the project."
  (let* ((pp (or pom (pom-read-pom)))
	 (basedir (pom-get-tag pp "basedir")))
    (append (list (expand-file-name "target/classes" basedir)
		  (expand-file-name "target/test-classes" basedir))
	    (pom-get-dependent-jars pp repository))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Reading and parsing property files
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun pom-read-properties (file)
  "Read java property files."
  (let ((keep))
    (if (get-file-buffer file)
	(progn
	  (set-buffer (get-file-buffer file))
	  (setq keep (point)))
      (let (auto-mode-alist magic-mode-alist find-file-hook)
	(set-buffer (find-file-noselect file))))
    (let ((props (pom-parse-properties (point-min) (point-max))))
      (if keep
	  (goto-char keep)
	(kill-buffer (current-buffer)))
      props)))

(defun pom-parse-properties (beg end)
  "Parse java properties in region"
  (let ((props nil))
    (save-excursion
      (goto-char beg)
      (while (search-forward-regexp
	     "^\\s *\\([0-9A-Za-z_\\-\\.]+\\)\\s *=\\s *\\(.*\\)\\s *$" end t)
	(push (list (match-string 1) (match-string 2)) props)))
    (and props (list (append (list "properties") (nreverse props))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; A simple xml parser for the POM.
;;  Taken and simplified from an older verison of xml.el
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun pom-parse-pom (file)
  "Parse the well-formed POM FILE.
If FILE is already edited, this will keep the buffer alive.
Returns the top node with all its children."
  (let ((keep))
    (if (get-file-buffer file)
	(progn
	  (set-buffer (get-file-buffer file))
	  (setq keep (point)))
      (let (auto-mode-alist magic-mode-alist find-file-hook)
	(set-buffer (find-file-noselect file))))
    (let ((pom (pom-parse-region (point-min) (point-max))))
      (if keep
	  (goto-char keep)
	(kill-buffer (current-buffer)))
      pom)))

(defun pom-parse-region (beg end)
  "Parse the region from BEG to END in BUFFER."
  (let (pom result)
    (save-excursion
      (goto-char beg)
      (while (< (point) end)
	(if (search-forward "<" end t)
	    (progn
	      (forward-char -1)
	      (if (null pom)
		  (progn
		    (set 'result (pom-parse-tag end))
		    (cond
		     ((listp (car result))
		      (add-to-list 'pom (cdr result)))
		     (t
		      (add-to-list 'pom result))))
		(error "POM files can have only one toplevel tag.")))
	  (goto-char end)))
      (reverse pom))))


(defun pom-parse-tag (end)
  "Parse the tag that is just in front of point.
The end tag must be found before the position END in the current buffer.
Returns one of:
   - a list : the matching node
   - nil    : the point is not looking at a tag."
  (cond
   ;; Processing instructions (like the <?xml version="1.0"?> tag at the
   ;; beginning of a document)
   ((looking-at "<\\?")
    (search-forward "?>" end)
    (skip-chars-forward " \t\n")
    (pom-parse-tag end))
   ;;  Character data (CDATA) sections, in which no tag should be interpreted
   ((looking-at "<!\\[CDATA\\[")
    (let ((pos (match-end 0)))
      (unless (search-forward "]]>" end t)
	(error "CDATA section does not end anywhere in the document"))
      (buffer-substring-no-properties pos (match-beginning 0))))
   ;;  skip DTD for the document
   ((looking-at "<!DOCTYPE")
    (search-forward ">" end)
    (skip-chars-forward " \t\n")
    (pom-parse-tag end))
   ;;  skip comments
   ((looking-at "<!--")
    (search-forward "-->" end)
    (skip-chars-forward " \t\n")
    (pom-parse-tag end))
   ;;  end tag
   ((looking-at "</")
    '())
   ;;  opening tag
   ((looking-at "<\\([^/> \t\n]+\\)")
    (let* ((node-name (match-string 1))
	   (children (list node-name))
	   (case-fold-search nil) ;; XML is case-sensitive
	   pos)
      (goto-char (match-end 1))

      ;; ignore the attribute list; not needed for POMs

      ;; is this an empty element ?
      (if (looking-at "[ \t\n]*/>")
	  (progn
	    (skip-chars-forward " \t\n")
	    (forward-char 2)
	    (skip-chars-forward " \t\n")
	    (append children '("")))

	;; is this a valid start tag ?
	(if (= (char-after) ?>)
	    (progn
	      (forward-char 1)
	      (skip-chars-forward " \t\n")
	      ;;  Now check that we have the right end-tag. Note that this one
	      ;; might contain spaces after the tag name
	      (while (not (looking-at (concat "</" node-name "[ \t\n]*>")))
		(cond
		 ((looking-at "</")
		  (error (concat
			  "POM: invalid syntax -- invalid end tag (expecting "
			  node-name
			  ") at pos " (number-to-string (point)))))
		 ((= (char-after) ?<)
		  (set 'children (append children (list (pom-parse-tag end)))))
		 (t
		  (set 'pos (point))
		  (search-forward "<" end)
		  (forward-char -1)
		  (let ((string (buffer-substring-no-properties pos (point)))
			(pos 0))
		    (set 'children (append children
					   (list string)))))))
	      (goto-char (match-end 0))
	      (skip-chars-forward " \t\n")
	      (if (> (point) end)
		  (error "POM: End tag for %s not found before end of region."
			 node-name))
	      children
	      )

	  ;;  This was an invalid start tag
	  (error "POM: Invalid attribute list")))))))

(provide 'pom)

;;; EOF