Mercurial > coderloop

     1 (ns coderloop.export-files

     2   (:use clojure.java.io)

     3   (:use [clojure.contrib [duck-streams :only [file-str]]])

     4   (:use [rlm

     5 	 [classpath-utils :only [classpath]]

     6 	 [shell-write :only [sw]]])

     7   (:require clojure.string)

     8   (:import java.io.File)

     9   (:import [org.apache.commons.io FileUtils])

    10   )

    11 

    12 

    13 (defn trans-print [x] (println x) x) 

    14 

    15 (def *nailgun* true)

    16 

    17 ;;; put standard base-path on the classpath

    18 (def standard-base-directory (file-str "~/.clojure-exports/"))

    19 

    20 (defn better-export-files [namespace name]

    21     (binding [*compile-path* (.getPath standard-base-directory)]

    22     ;;clear out classes -- prepare temp directory

    23     (FileUtils/forceMkdir standard-base-directory)

    24     (FileUtils/deleteDirectory standard-base-directory)

    25     (FileUtils/forceMkdir standard-base-directory)      

    26       ;; make classes

    27     (compile (symbol (str namespace)))

    28     

    29     ;; make jar

    30 ;;    (jar {:jarfile jar-name :basedir temp-class-dir})

    31     

    32     ;; move jar

    33 ;;    (FileUtils/copyFileToDirectory jar-name target-lib-dir)

    34     ))

    35 

    36 (defmulti source-location class)

    37 

    38 (defmethod source-location clojure.lang.Var [sym]

    39 	   (let [source? (:file (meta sym))]

    40 	     (if source?

    41 	       (.getResource (clojure.lang.RT/baseLoader) source?)

    42 	       nil)))

    43 

    44 (defmethod source-location java.lang.Class [sym]

    45 	   (let [source? (.getCodeSource (.getProtectionDomain sym))]

    46 	     (if source?

    47 	       (.getLocation source?)

    48 	       nil)))

    49 

    50 (defn all-dependent-namespaces [namespace]

    51   (set

    52    (concat

    53     [namespace]

    54     (vals (ns-aliases namespace))

    55     (map #(.ns %)

    56 	 (filter #(= (class %) clojure.lang.Var)

    57 		 (concat 

    58 		  (vals (ns-map namespace))

    59 		  (vals (ns-refers namespace))))))))

    60 

    61 (defn deep-dependent-namespaces [namespace-set]

    62   (let [new-namespaces (set (mapcat all-dependent-namespaces namespace-set))]

    63     ;;(println (count new-namespaces))

    64     (if (= new-namespaces namespace-set)

    65       namespace-set

    66       (recur new-namespaces))))

    67 

    68 (defn dependencies-url

    69   "returns all of the files necessary to succesfully run the namespace."

    70   [namespace]

    71   (set

    72    (remove

    73     nil?

    74     (map source-location

    75 	 (map second

    76 	      (mapcat ns-map (deep-dependent-namespaces #{namespace})))))))

    77 

    78 (defn dependencies-file [namespace]

    79   (map file-str

    80        (set

    81 	(map #(.replaceFirst % "file:" "")

    82 	     (map  #(if (.contains % ".jar!/")

    83 		      (clojure.string/replace % #"\.jar.*" ".jar") %)

    84 		   (map #(.getFile %) (dependencies-url namespace)))))))

    85 

    86 (defn classpath-files []

    87   (map file-str (clojure.string/split (classpath) #":")))

    88 

    89 ;;Every file that comes back from dependencies-file is also on the classpath.

    90 ;;In order to recreate the right project structure, we need to copy the files 

    91 ;;with the appropiate classpath nesting.

    92 

    93 (defn bifurcate

    94   "split a collection between f and not f"

    95   [f coll]

    96   (list

    97    (filter f coll)

    98    (filter (comp not f) coll)))

    99 

   100 (defn jar? [#^java.io.File f]

   101   (re-matches  #".*\.jar$" (.getCanonicalPath f)))

   102 

   103 (defn contains-file? [#^java.io.File parent #^java.io.File child]

   104   (let [new-child (.getParentFile child)]

   105     (cond (nil? new-child) false

   106 	  (= new-child parent) true

   107 	  true (recur parent new-child))))

   108 

   109 (defn destination [base-path-list #^java.io.File current-file #^java.io.File base-destination]

   110   (let [base-path (last (filter #(contains-file? % current-file) base-path-list))]

   111     (file-str

   112      (.replaceFirst (.getCanonicalPath current-file)

   113 		    (.getCanonicalPath base-path)

   114 		    (.getCanonicalPath base-destination)))))

   115 

   116 (defn export-dependencies [namespace #^java.io.File target]

   117   (let [[jars sources] (bifurcate jar? (dependencies-file namespace))

   118 	jars (if *nailgun*

   119 	       (conj jars (file-str "~/roBin/nailgun-0.7.1/nailgun-0.7.1.jar"))

   120 	       jars)

   121        

   122 	lib (file-str (str (.getCanonicalPath target) File/separatorChar "lib"))

   123 	src (file-str (str (.getCanonicalPath target) File/separatorChar "src"))]

   124     (if *nailgun*

   125       (do

   126 	(FileUtils/copyFileToDirectory (file-str "~/roBin/nailgun-0.7.1/ng") lib)

   127 	(sw (str "chmod +x " (.getCanonicalPath target) File/separatorChar "lib/ng"))))

   128     (dorun (map #(FileUtils/copyFileToDirectory % lib) jars))

   129     (dorun (map #(FileUtils/copyFile % (destination (classpath-files) % src)) sources))))

   130 

   131 (defn run-script-text [namespace]

   132   

   133   (if *nailgun*

   134     (str

   135      

   136      "#!/usr/bin/perl

   137 

   138 if (`./lib/ng ng-alias 2>&1 1>/dev/null` eq \"connect: Connection refused\\n\"){

   139 	

   140 	$nailgun_init = 

   141 	\"java -Xmn500M -Xms2000M -Xmx2000M \" . 

   142 	\"-classpath ./src/:lib/*\" . \" -server \". 

   143 	\"com.martiansoftware.nailgun.NGServer \". 

   144 	\" >/dev/null 2>/dev/null &\";

   145 	`$nailgun_init`;

   146 	}\n\n"

   147      

   148      

   149      "while (`./lib/ng ng-alias 2>&1 1>/dev/null` eq \"connect: Connection refused\\n\"){

   150     }\n\n"

   151      

   152      "$command = "

   153      

   154      

   155      "\"./lib/ng clojure.main "

   156      "./src/"

   157      (.replace (.replace (str *ns*) \. File/separatorChar) \- \_)

   158      ".clj "

   159      " @ARGV\";\n"

   160      

   161      "print `$command`;\n")

   162     (str

   163      "#!/bin/bash\n"

   164      "java -Xmn500M -Xms2000M -Xmx2000M -server -cp ./lib/*:./src clojure.main "

   165      "./src/"

   166      (.replace (.replace (str *ns*) \. File/separatorChar) \- \_)

   167      ".clj "

   168      " $@\n")))

   169 

   170 

   171 

   172 (defn make-run-script [namespace base-dir name]

   173   (let [w (clojure.java.io/writer

   174 	   (str (.getCanonicalPath base-dir) File/separatorChar name))]

   175     (.write w (run-script-text namespace))

   176     (.close w))

   177   (let [f (file-str  (str (.getCanonicalPath base-dir) File/separatorChar name))]

   178     (.setExecutable f true)))

   179 

   180 (defn export-files [namespace base-dir name]

   181   (export-dependencies namespace base-dir)

   182   (make-run-script namespace base-dir name))

   183 

   184 (defn bzip-folder [#^java.io.File destination #^java.io.File directory]

   185   (apply (partial sw "tar" "-cvjf" (.getCanonicalPath destination))

   186 	 (concat

   187 	  (rest

   188 	   (map #(.replaceFirst

   189 		  %

   190 		  (str (.getCanonicalPath directory) File/separatorChar ) "")

   191 		(map str (file-seq directory))))

   192 	  [:dir (.getCanonicalPath directory)])))

   193 

   194 (defn bzip-export-files [directory target-dir name]

   195   (apply (partial sw "tar" "-cvjf"

   196 		  (str (.getCanonicalPath target-dir) File/separatorChar name))

   197 	 (concat

   198 	  [name "lib" "src"]

   199 	  [:dir (.getCanonicalPath directory)])))

   200 

   201 (defn export-archive

   202   ([name]

   203      (export-archive *ns* name))

   204   

   205   ([namespace name nailgun?]

   206      (binding [*nailgun* nailgun?]

   207        (export-archive namespace name)))

   208   

   209   ([namespace name]

   210      (FileUtils/forceMkdir standard-base-directory)

   211      (FileUtils/forceDelete standard-base-directory)

   212      (FileUtils/forceMkdir standard-base-directory)

   213      (let [new-dir

   214 	   (file-str

   215 	    (str

   216 	     (.getCanonicalPath standard-base-directory)

   217 	     (File/separatorChar)

   218 	     name))]

   219        

   220        (export-files namespace new-dir name)

   221 

   222        (bzip-export-files new-dir (file-str "~/coderloop/") (str name "-clojure.tar.bz2"))

   223        (FileUtils/copyFileToDirectory

   224 	(file-str (str "~/coderloop/" name "-clojure.tar.bz2"))

   225 	(file-str "~/coderloop-test")))))
author	Robert McIntyre <rlm@mit.edu>
date	Tue, 18 Oct 2011 01:17:49 -0700
parents
children