extra/webapps/mason/utils/utils.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs db.tuples furnace.actions
   4 furnace.utilities html.forms kernel namespaces sequences
   5 validators xml.syntax urls mason.config
   6 webapps.mason.version.data webapps.mason.backend ;
   7 IN: webapps.mason.utils
   8
   9 : link ( url label -- xml )
  10     [XML <a href=<->><-></a> XML] ;
  11
  12 : validate-os/cpu ( -- )
  13     {
  14         { "os" [ v-one-line ] }
  15         { "cpu" [ v-one-line ] }
  16     } validate-params ;
  17
  18 : current-builder ( -- builder )
  19     builder new "os" value >>os "cpu" value >>cpu select-tuple ;
  20
  21 : current-release ( -- builder )
  22     release new "os" value >>os "cpu" value >>cpu select-tuple ;
  23
  24 : requirements ( builder -- xml )
  25     [
  26         os>> {
  27             { "windows" "Windows XP, Windows Vista or Windows 7" }
  28             { "macosx" "Mac OS X 10.5 Leopard" }
  29             { "linux" "Ubuntu Linux 9.04 (other distributions may also work)" }
  30             { "freebsd" "FreeBSD 7.1" }
  31             { "netbsd" "NetBSD 5.0" }
  32             { "openbsd" "OpenBSD 4.5" }
  33         } at
  34     ] [
  35         dup cpu>> "x86.32" = [
  36             os>> "macosx" =
  37             f "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2."
  38             ?
  39         ] [ drop f ] if
  40     ] bi
  41     2array sift [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ;
  42
  43 : download-url ( string -- string' )
  44     "http://downloads.factorcode.org/" prepend ;
  45
  46 : package-url ( builder -- url )
  47     [ URL" http://builds.factorcode.org/package" ] dip
  48     [ os>> "os" set-query-param ]
  49     [ cpu>> "cpu" set-query-param ] bi
  50     adjust-url ;
  51
  52 : release-url ( builder -- url )
  53     [ URL" http://builds.factorcode.org/release" ] dip
  54     [ os>> "os" set-query-param ]
  55     [ cpu>> "cpu" set-query-param ] bi
  56     adjust-url ;
  57
  58 : validate-secret ( -- )
  59     { { "secret" [ v-one-line ] } } validate-params
  60     "secret" value status-secret get =
  61     [ validation-failed ] unless ;