basis/http/download/download.factor

   1 ! Copyright (C) 2024 Doug Coleman.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors calendar checksums combinators.short-circuit
   4 http.client io io.backend io.directories io.encodings.binary
   5 io.files io.files.info io.files.unique io.pathnames kernel math
   6 math.order math.parser present sequences shuffle splitting ;
   7 IN: http.download
   8
   9 : file-too-old-or-not-exists? ( file duration -- ? )
  10     [ ?file-info [ created>> ] ?call ]
  11     [ ago ] bi*
  12     over [ before? ] [ 2drop t ] if ;
  13
  14 : delete-when-old ( file duration -- deleted? )
  15     dupd file-too-old-or-not-exists? [ ?delete-file t ] [ drop f ] if ;
  16
  17 : file-matches-checksum? ( file checksum-type bytes -- ? )
  18     [ checksum-file ] dip = ;
  19
  20 : delete-when-checksum-mismatches ( file checksum-type bytes -- deleted? )
  21     dupdd file-matches-checksum? [ drop f ] [ ?delete-file t ] if ;
  22
  23 : file-size= ( path n -- ? ) [ ?file-info [ size>> ] ?call ] dip = ;
  24
  25 : file-zero-size? ( path -- ? ) 0 file-size= ;
  26
  27 : delete-when-zero-size ( path -- deleted-or-not-exists? )
  28     dup file-exists? [
  29         dup file-zero-size? [ ?delete-file t ] [ drop f ] if
  30     ] [
  31         drop t
  32     ] if ;
  33
  34 : delete-when-file-size-mismatches? ( file size -- deleted? )
  35     dupd file-size= [ drop f ] [ ?delete-file t ] if ;
  36
  37 : download-name ( url -- name )
  38     present file-name "?" split1 drop "/" ?tail drop ;
  39
  40 <PRIVATE
  41
  42 : increment-file-extension ( path -- path' )
  43     dup file-extension
  44     [ ?tail drop ]
  45     [
  46         ?string>number
  47         [ 1 + number>string append ]
  48         [ ".1" 3append ] if
  49     ] bi ;
  50
  51 : ?parenthesis-number ( str -- n/str ? )
  52     dup { [ "(" head? ] [ ")" tail? ] } 1&&
  53     [ rest but-last ?string>number ] [ f ] if ;
  54
  55 : increment-file-name ( path -- path' )
  56     [
  57         file-stem " " split1-last
  58         ?parenthesis-number
  59         [ 1 + number>string "(" ")" surround " " glue ]
  60         [ "(1)" append " " glue ] if
  61     ] [
  62         file-extension
  63     ] bi "." glue ;
  64
  65 : find-next-incremented-name ( path -- path' )
  66     dup file-exists? [
  67         increment-file-name find-next-incremented-name
  68     ] when ;
  69
  70 : next-download-name ( url -- name )
  71     download-name find-next-incremented-name ;
  72
  73 : http-write-request ( url -- )
  74     <get-request> [ write ] with-http-request drop ;
  75
  76 : download-temporary-name ( url -- prefix suffix )
  77     [ "temp." ".temp" ] dip download-name prepend ;
  78
  79 PRIVATE>
  80
  81 : download-to ( url file -- path )
  82     [
  83         [ download-temporary-name binary ] keep
  84         '[ _ http-write-request ] with-unique-file-writer
  85     ] dip [ move-file ] keep ;
  86
  87 : download-once-to ( url file -- path )
  88     dup file-exists? [ nip ] [ download-to ] if ;
  89
  90 : download-outdated-to ( url file duration -- path )
  91     2dup delete-when-old [ drop download-to ] [ drop nip ] if ;
  92
  93 : download ( url -- path )
  94     dup download-name download-to ;