extra/mason/release/archive/archive.factor

   1 ! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators io.directories io.pathnames kernel
   4 make mason.common mason.config mason.platform namespaces
   5 sequences system words ;
   6 IN: mason.release.archive
   7
   8 : base-name ( -- string )
   9     [ "factor-" % platform % "-" % stamp get % ] "" make ;
  10
  11 : extension ( os -- extension )
  12     dup word? [ name>> ] when
  13     {
  14         { "windows" [ ".zip" ] }
  15         { "macosx" [ ".dmg" ] }
  16         [ drop ".tar.gz" ]
  17     } case ;
  18
  19 : archive-name ( -- string )
  20     base-name target-os get extension append ;
  21
  22 :: make-windows-archive ( archive-name -- )
  23     { "zip" "-r" archive-name "factor" } short-running-process ;
  24
  25 :: make-disk-image ( archive-name volume-name dmg-root -- )
  26     {
  27         "hdiutil" "create"
  28         "-srcfolder" dmg-root
  29         "-fs" "HFS+"
  30         "-volname" volume-name
  31         archive-name
  32     } short-running-process ;
  33
  34 ! Make the .dmg
  35 : make-macosx-archive ( archive-name -- )
  36     "dmg-root" make-directory
  37     "factor" "dmg-root" copy-tree-into
  38     "factor" "dmg-root" make-disk-image
  39     "dmg-root" delete-tree ;
  40
  41 :: make-unix-archive ( archive-name -- )
  42     { "tar" "-cvzf" archive-name "factor" } short-running-process ;
  43
  44 : make-archive ( archive-name -- )
  45     target-os get {
  46         { windows [ make-windows-archive ] }
  47         { macosx [ make-macosx-archive ] }
  48         [ drop make-unix-archive ]
  49     } case ;
  50
  51 : releases ( -- path )
  52     builds-dir get "releases" append-path dup make-directories ;
  53
  54 : save-archive ( archive-name -- )
  55     releases move-file-into ;