[bug#27554] Add dirvish and dependencies

[Christopher Allan Webber]

This adds dirvish (a backup program) along with dependencies of
perl-libtime-parsedate and perl-libtime-period.

>From 60a448f1daf37927155577dabaf1c090f9404bee Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <address@hidden>
Date: Sat, 1 Jul 2017 20:45:04 -0500
Subject: [PATCH 1/3] gnu: Add perl-libtime-parsedate.

* gnu/packages/perl.scm (perl-libtime-parsedate): New variable.
---
 gnu/packages/perl.scm | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/gnu/packages/perl.scm b/gnu/packages/perl.scm
index 6da4bb13f..6906bc2bb 100644
--- a/gnu/packages/perl.scm
+++ b/gnu/packages/perl.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2017 Marius Bakke <address@hidden>
 ;;; Copyright © 2017 Adriano Peluso <address@hidden>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <address@hidden>
+;;; Copyright © 2017 Christopher Allan Webber <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -8248,3 +8249,41 @@ interface to File::Find::Object.")
   (description "Test::TrailingSpace tests for trailing spaces
 in Perl source files.")
   (license x11)))
+
+(define-public perl-libtime-parsedate
+  (package
+    (name "perl-libtime-parsedate")
+    (version "2015.103")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "mirror://cpan/authors/id/M/MU/MUIR/modules/Time-ParseDate-"
+             version ".tar.gz"))
+       (sha256
+        (base32 "1lgfr87j4qwqnln0hyyzgik5ixqslzdaksn9m8y824gqbcihc6ic"))))
+    (build-system perl-build-system)
+    (arguments
+     ;; Output when running tests:
+     ;;   t/metdate.t ... skipped: It seems localtime() does not honor
+     ;;   $ENV{TZ} when set in the test script.
+     ;; Seemingly related:
+     ;;   
https://stackoverflow.com/questions/19956693/timeparsedate-install-fail
+     ;;   https://rt.cpan.org/Public/Bug/Display.html?id=90367
+     `(#:tests? #f))
+    (native-inputs
+     `(("perl-module-build" ,perl-module-build)))
+    (home-page
+     "https://metacpan.org/release/Time-ParseDate";)
+    (synopsis
+     "Collection of Perl modules for time/date manipulation")
+    (description "Provides several perl modules for date/time manipulation:
+Time::CTime.pm, Time::JulianDay.pm, Time::ParseDate.pm, Time::Timezone.pm,
+and Time::DaysInMonth.pm.")
+    ;; License text:
+    ;;   "License hereby granted for anyone to use, modify or redistribute this
+    ;;   module at their own risk. Please feed useful changes back to
+    ;;   address@hidden"
+    (license (non-copyleft "http://metadata.ftp-master.debian.org/\
+changelogs/main/libt/libtime-parsedate-perl/\
+libtime-parsedate-perl_2015.103-2_copyright"))))
-- 
2.13.1

>From f475a133812a4d62e32a90caa26f41bb242f8a37 Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <address@hidden>
Date: Sat, 1 Jul 2017 20:46:00 -0500
Subject: [PATCH 2/3] gnu: Add perl-libtime-period.

* gnu/packages/perl.scm (perl-libtime-period): New variable.
---
 gnu/packages/perl.scm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/gnu/packages/perl.scm b/gnu/packages/perl.scm
index 6906bc2bb..93b74df8e 100644
--- a/gnu/packages/perl.scm
+++ b/gnu/packages/perl.scm
@@ -8287,3 +8287,32 @@ and Time::DaysInMonth.pm.")
     (license (non-copyleft "http://metadata.ftp-master.debian.org/\
 changelogs/main/libt/libtime-parsedate-perl/\
 libtime-parsedate-perl_2015.103-2_copyright"))))
+
+(define-public perl-libtime-period
+  (package
+    (name "perl-libtime-period")
+    (version "1.20")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "http://http.debian.net/debian/pool/main/libt/";
+             "libtime-period-perl/libtime-period-perl_"
+             version ".orig.tar.gz"))
+       (sha256
+        (base32 "0c0yd999h0ikj88c9j95wa087m87i0qh7vja3715y2kd7vixkci2"))))
+    (build-system perl-build-system)
+    (native-inputs
+     `(("perl-module-build" ,perl-module-build)))
+    ;; Unless some other homepage is out there...
+    (home-page
+     "https://packages.debian.org/stretch/libtime-period-perl";)
+    (synopsis
+     "Perl library for testing if a time() is in a specific period")
+    (description "This Perl library provides a function which tells whether a
+specific time falls within a specified time period.  Its syntax for specifying
+time periods allows you to test for conditions like \"Monday to Friday, 9am
+till 5pm\" and \"on the second Tuesday of the month\" and \"between 4pm and
+4:15pm\" and \"in the first half of each minute\" and \"in January of
+1998\".")
+    (license (package-license perl))))
-- 
2.13.1

>From 01b0c93222658f74d5049f1666d383efacf4a724 Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <address@hidden>
Date: Sun, 20 Nov 2016 10:36:46 -0600
Subject: [PATCH 3/3] gnu: Add dirvish.

* gnu/packages/backup.scm (dirvish): New variable.
---
 gnu/packages/backup.scm | 108 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 108 insertions(+)

diff --git a/gnu/packages/backup.scm b/gnu/packages/backup.scm
index 74e49e46d..9285d1213 100644
--- a/gnu/packages/backup.scm
+++ b/gnu/packages/backup.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2017 Thomas Danckaert <address@hidden>
 ;;; Copyright © 2017 Arun Isaac <address@hidden>
 ;;; Copyright © 2017 Kei Kebreau <address@hidden>
+;;; Copyright © 2017 Christopher Allan Webber <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,6 +45,7 @@
   #:use-module (gnu packages linux)
   #:use-module (gnu packages mcrypt)
   #:use-module (gnu packages nettle)
+  #:use-module (gnu packages perl)
   #:use-module (gnu packages pcre)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
@@ -685,3 +687,109 @@ using GnuPG.  Backups can be stored on local hard disks, 
or online via
 the SSH SFTP protocol.  The backup server, if used, does not require
 any special software, on top of SSH.")
     (license license:gpl3+)))
+
+(define-public dirvish
+  (package
+    (name "dirvish")
+    (version "1.2.1")
+    (build-system gnu-build-system)
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "http://dirvish.org/dirvish-"; version ".tgz"))
+              (sha256
+               (base32
+                "1kbxa1irszp2zw8hd5qzqnrrzb4vxfivs1vn64yxnj0lak1jjzvb"))))
+    (arguments
+     `(#:modules ((ice-9 match) (ice-9 rdelim)
+                  ,@%gnu-build-system-modules)
+       #:phases
+       ;; This mostly mirrors the steps taken in the install.sh that ships
+       ;; with dirvish, but simplified because we aren't prompting 
interactively
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (delete 'build)
+         (delete 'check)
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             ;; These are mostly the same steps the install.sh that comes with
+             ;; dirvish does
+             (let* (;; Files we'll be copying
+                    (executables
+                     '("dirvish" "dirvish-runall"
+                       "dirvish-expire" "dirvish-locate"))
+                    (man-pages
+                     '(("dirvish" "8") ("dirvish-runall" "8")
+                       ("dirvish-expire" "8") ("dirvish-locate" "8")
+                       ("dirvish.conf" "5")))
+
+                    (output-dir
+                     (assoc-ref outputs "out"))
+
+                    ;; Just a default... not so useful on guixsd though
+                    ;; You probably want to a service with file(s) to point to.
+                    (confdir "/etc/dirvish")
+
+                    (perl (string-append (assoc-ref %build-inputs "perl")
+                                         "/bin/perl"))
+                    (loadconfig.pl (call-with-input-file "loadconfig.pl"
+                                     read-string)))
+
+
+               (define (write-pl filename)
+                 (define pl-header
+                   (string-append "#!" perl "\n\n"
+                                  "$CONFDIR = \"" confdir "\";\n\n"))
+                 (define input-file-location
+                   (string-append filename ".pl"))
+                 (define target-file-location
+                   (string-append output-dir "/bin/" filename ".pl"))
+                 (define text-to-write
+                   (string-append pl-header
+                                  (call-with-input-file input-file-location
+                                    read-string)
+                                  "\n" loadconfig.pl))
+                 (with-output-to-file target-file-location
+                   (lambda ()
+                     (display text-to-write)))
+                 (chmod target-file-location #o755)
+                 (wrap-program target-file-location
+                   `("PERL5LIB" ":" prefix
+                     ,(map (lambda (l) (string-append (assoc-ref %build-inputs 
l)
+                                                      "/lib/perl5/site_perl"))
+                           '("perl-libtime-period"
+                             "perl-libtime-parsedate")))))
+
+               (define write-man
+                 (match-lambda
+                   ((file-base man-num)
+                    (let* ((filename
+                            (string-append file-base "." man-num))
+                           (output-path
+                            (string-append output-dir
+                                           "/share/man/man" man-num
+                                           "/" filename)))
+                      (copy-file filename output-path)))))
+
+               ;; Make directories
+               (mkdir-p (string-append output-dir "/bin/"))
+               (mkdir-p (string-append output-dir "/share/man/man8/"))
+               (mkdir-p (string-append output-dir "/share/man/man5/"))
+
+               ;; Write out executables
+               (for-each write-pl executables)
+               ;; Write out man pages
+               (for-each write-man man-pages)
+               #t))))))
+    (inputs
+     `(("perl" ,perl)
+       ("rsync" ,rsync)
+       ("perl-libtime-period" ,perl-libtime-period)
+       ("perl-libtime-parsedate" ,perl-libtime-parsedate)))
+    (synopsis "Fast, disk based, rotating network backup system")
+    (description
+     "With dirvish you can maintain a set of complete images of your
+filesystems with unattended creation and expiration.  A dirvish backup vault is
+like a time machine for your data. ")
+    (home-page "http://dirvish.org/";)
+    (license (license:fsf-free "file://COPYING")))) ; Open Software License 2.0
-- 
2.13.1