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 

    10 (import '[org.apache.commons.io FileUtils])

    11 

    12 ;;(use '[telmo.rlm [dist :only [dist]]])

    13 

    14 (def *nailgun* true)

    15 

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

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

    18 

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

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

    21     ;;clear out classes -- prepare temp directory

    22     (FileUtils/forceMkdir standard-base-directory)

    23     (FileUtils/deleteDirectory standard-base-directory)

    24     (FileUtils/forceMkdir standard-base-directory)      

    25       ;; make classes

    26     (compile (symbol (str namespace)))

    27     

    28     ;; make jar

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

    30     

    31     ;; move jar

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

    33     ))

    34 

    35 (defmulti source-location class)

    36 

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

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

    39 	     (if source?

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

    41 	       nil)))

    42 

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

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

    45 	     (if source?

    46 	       (.getLocation source?)

    47 	       nil)))

    48 

    49 (defn all-dependent-namespaces [namespace]

    50   (set

    51    (concat

    52     [namespace]

    53     

    54     (vals (ns-aliases namespace))

    55 

    56     (map #(.ns %)

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

    58 		 (concat 

    59 		  

    60 		  (vals (ns-map namespace))

    61 		  (vals (ns-refers namespace))

    62 		  

    63 		  ))))))

    64 

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

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

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

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

    69       namespace-set

    70       (recur new-namespaces))))

    71 

    72 

    73 (defn dependencies-url

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

    75   [namespace]

    76   (set

    77    (remove nil?

    78 	   (map source-location

    79 		(map second

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

    81 

    82 

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

    84 

    85 (defn dependencies-file [namespace]

    86   (map file-str

    87        (set

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

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

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

    91 		 %)

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

    93 

    94 

    95 

    96 (defn classpath-files []

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

    98 

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

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

   101 ;;with the appropiate classpath nesting.

   102 

   103 (defn bifurcate

   104   "split a collection between f and not f"

   105   [f coll]

   106   (list

   107    (filter f coll)

   108    (filter (comp not f) coll)))

   109 

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

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

   112 

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

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

   115     (cond (nil? new-child) false

   116 	  (= new-child parent) true

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

   118 

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

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

   121     (file-str

   122      (.replaceFirst (.getCanonicalPath current-file)

   123 		    (.getCanonicalPath base-path)

   124 		    (.getCanonicalPath base-destination)))))

   125 

   126 (defn export-dependencies

   127   ([namespace #^java.io.File target src* lib*]

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

   129 	   jars (if *nailgun*

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

   131 		  jars)

   132 	   

   133 	   lib (file-str (str (.getCanonicalPath target) File/separatorChar lib*))

   134 	   src (file-str (str (.getCanonicalPath target) File/separatorChar src*))]

   135        (if *nailgun*

   136 	 (do

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

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

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

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

   141   

   142   ([namespace #^java.io.File target]

   143      (export-dependencies namespace target "src" "lib")))

   144 

   145 (defn run-script-text

   146   ([namespace]

   147      (run-script-text namespace "src" "lib"))

   148   ([namespace src lib] 

   149      (if *nailgun*

   150        (str

   151 	

   152 	"#!/usr/bin/perl

   153 

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

   155 	

   156 	$nailgun_init = 

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

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

   159 	\"com.martiansoftware.nailgun.NGServer \". 

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

   161 	`$nailgun_init`;

   162 	}\n\n"

   163 	

   164 	

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

   166     }\n\n"

   167 	

   168 	"$command = "

   169 	

   170 	

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

   172 	"./"src"/"

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

   174 	".clj "

   175 	" @ARGV\";\n"

   176 	

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

   178        (str

   179 	"#!/bin/bash\n"

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

   181 	"./"src"/"

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

   183 	".clj "

   184 	" $@\n"))))

   185 

   186 

   187 

   188 (defn make-run-script

   189   ([namespace base-dir name]

   190      (make-run-script namespace base-dir name "src" "lib"))

   191   ([namespace base-dir name src lib]

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

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

   194     (.write w (run-script-text namespace src lib))

   195     (.close w))

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

   197     (.setExecutable f true))))

   198 

   199 

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

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

   202 

   203 	  (concat

   204 	   (rest

   205 	    (map #(.replaceFirst

   206 		   %

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

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

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

   210 

   211 

   212 (defn bzip-export-files

   213   ([directory to name postfix]

   214      (bzip-export-files directory to name postfix "src" "lib"))

   215 

   216   ([directory to name postfix src lib]

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

   218 		     (str (.getCanonicalPath to) File/separatorChar (str name postfix)))

   219 	    (concat

   220 	     [name src lib]

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

   222 

   223 (defn export-archive

   224   ([name]

   225      (export-archive *ns* name))

   226 

   227   ([namespace name nailgun?]

   228      (binding [*nailgun* nailgun?]

   229        (export-archive namespace name)))

   230   

   231   ([namespace name]

   232      (FileUtils/forceMkdir standard-base-directory)

   233      (FileUtils/forceDelete standard-base-directory)

   234      (FileUtils/forceMkdir standard-base-directory)

   235      (let [new-dir (file-str (str

   236 			      (.getCanonicalPath standard-base-directory)

   237 			      (File/separatorChar)

   238 			      name))]

   239        (export-dependencies namespace new-dir)

   240        (make-run-script namespace new-dir name)

   241        (println (str name "-clojure.tar.bz2"))

   242        (println name)

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

   244        (FileUtils/copyFileToDirectory

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

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