#!/usr/bin/env perl # File: tar-home # SPDX-License-Identifier: Apache-2.0 # Copyright 2023 Justin Hanekom # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. package App::TarHome; use strict; use autodie qw( :all ); use 5.030; # Equivalent to 'use strictures 2' use warnings FATAL => 'all'; use warnings NONFATAL => qw( deprecated exec experimental internal malloc newline portable recursion ); # These modules may not be available, in which case we can safely ignore them eval { no bareword::filehandles } or 1; eval { no indirect 'fatal' } or 1; eval { no multidimensional } or 1; use Getopt::Long qw( :config auto_help bundling gnu_getopt no_ignore_case ); use Pod::Usage qw( pod2usage ); use Scalar::Util qw( looks_like_number ); use List::MoreUtils qw( all ); use Carp qw( carp croak ); use English qw( -no_match_vars ); use Smart::Comments; # to disable smart comments comment out this line our $VERSION = 1.000; #-------------------------------------------------------------------------- # Usage : %options = _parse_cmdline() # Purpose : Parses any and all command-line arguments and/or options # Returns : A hash of the found arguments / options # Parameters : none # Throws : no exceptions # Comments : The keys of the returned hash are: # 'indir' - the directory to be tarred; # 'nice' - the niceness increment to apply to the tar # process (0 if nice should not be used); # 'pigz' - 1 if the compression should be performed by # pigz so that multiple threads are used; and # 'outfile' - the name of tar file to create. # See also : Getopt::Long#GetOptions #-------------------------------------------------------------------------- sub _parse_cmdline { # Variables that will be set in response to command line arguments # with default values in case those arguments are not provided my $indir = q{~}; my $nice = 0; my $use_pigz = 0; # Specify command line options and process command line... my $options_okay = GetOptions( # Application-specific options... 'i|indir=s' => \$indir, # --indir option expects a string 'n|nice:10' => \$nice, # --nice option expects an integer, and # defaults to 20 if no value given 'p|pigz' => \$use_pigz, # --pigz flag is a boolean # Standard meta-options (the subroutines are are executed immediately # if the flag is encountered) 'h|help|?' => sub { pod2usage(1) }, 'm|man' => sub { pod2usage( '-verbose' => 2 ) }, 'v|version' => sub { pod2usage( '-sections' => 'VERSION', '-verbose' => 99 ) }, ); # Fail if unknown arguments were encountered if ( !$options_okay ) { pod2usage(); } # Fail if the --outfile argument was not provided if ( !@ARGV ) { pod2usage("$PROGRAM_NAME: OUTFILE is a required argument.\n"); } # The --outfile argument should be the only remaining command line argument my $outfile = shift @ARGV; # Fail if any command line arguments have not been processed if ( @ARGV > 0 ) { pod2usage("$PROGRAM_NAME: Too many command-line arguments.\n"); } my %result = ( 'indir' => $indir, 'nice' => $nice, 'pigz' => $use_pigz, 'outfile' => $outfile, ); ### _parse_cmdline - %result: %result ### assert: defined $result{'indir'} ### assert: defined $result{'nice'} ### assert: looks_like_number( $result{'nice'} ) ### assert: defined $result{'pigz'} ### assert: looks_like_number( $result{'pigz'} ) ### assert: defined $result{'outfile'} return %result; } # _parse_cmdline #-------------------------------------------------------------------------- # Usage : $tar_command = _tar_command( # 'indir' => '~', # 'nice' => 20, # 'use_pigz' => 0, ) # 'outfile' => '/tmp/home.tar.gz' # Purpose : Generates the exec string to be used to generate a tar file # using the given options # Returns : String to be used by exec to generate the tar file # Parameters : %opts = ( # 'indir' => 'an input directory', # 'nice' => the niceness factor to run tar under (or 0), # 'use_pigz' => 1, # if pigz should be used, and # 'outfile' => 'name/of/generated/outfile' ) # Throws : no exceptions # Comments : the method to use to compress the tar is determined by the # outfile extension (e.g., .gz, .xz, etc.) # See also : the Linux tar, nice, and pigz commands #-------------------------------------------------------------------------- sub _tar_command { # The options given on the command-line are received as a hash my %option_for = @ARG; ### _tar_command - %option_for: %option_for # Build up the tar command to be executed... # optionally run the tar command with a niceness factor my $tar_command; if ( $option_for{'nice'} ) { $tar_command = "nice -n $option_for{'nice'} "; } $tar_command .= 'tar '; # optionally use `pigz` to use multiple threads to compress content if ( $option_for{'pigz'} ) { $tar_command .= '--use-compress-program="pigz --keep " '; } $tar_command .= '--atime-preserve --auto-compress --create --ignore-failed-read ' . "--preserve-permissions --verbose --file $option_for{'outfile'} " . $option_for{'indir'}; ### $tar_command: $tar_command return $tar_command; } # _tar_command #-------------------------------------------------------------------------- # Usage : _main() # Purpose : the program entry point - generates a tar file # Returns : none # Parameters : none # Throws : no exceptions # Comments : the command-line arguments and options are retrieved from # the system automatically by Getopt::Long#GetOptions # See also : Getopt::Long#GetOptions #-------------------------------------------------------------------------- sub _main { my %option_for = _parse_cmdline(); ### _main - %option_for: %option_for my $tar_command = _tar_command(%option_for); # Now run the tar command and exit the program eval { exec $tar_command } or croak "Could not execute $tar_command:\n\t$EVAL_ERROR"; return; } # _main _main(); exit 0; __END__ =head1 NAME tar-home - tars the user's home directory to a file =head1 VERSION This is B version I<1.0.0>. =head1 USAGE tar-home [B<-i> I] [B<-n> [I]] [B<-p>] [B<-h>] [B<-m>] [B<-v>] I Tars (i.e., archives) the user's home directory to a file. positional arguments: outfile name of the tar file options: -i INDIR, --indir INDIR name of the directory to be tarred (defaults to "~") -n [NICE], --nice [NICE] niceness factor to use while creating the tar output file (NICE defaults to 10) -p, --pigz use pigz to perform the compression using multiple threads -h, --help, -? show this help message and exit -m, --man show the manual and exit -v, --version show program's version number and exit =head1 REQUIRED ARGUMENTS =over 8 =item F The name of the tar file to be created. =back =head1 OPTIONS =over 8 =item B<--indir> Sets the name of the directory to be tarred to F. =item B<--nice> Adds the integer I to the tar processes niceness. =item B<--pigz> Uses B to perform compression using multiple threads. =item B<--help> Prints a brief help message and exits. =item B<--man> Prints the manual and exits. =item B<--version> Prints the programs version and exits. =back =head1 DESCRIPTION Uses the B command, and possible the B and B commands to archive the home (or any other) directory. =head1 DIAGNOSTICS =over 8 =item B If B<--help>/B<-h>/B<-?> is provided on the command line then a help message is printed to I, and the program exits with exit code I<1>. =item B If B<--man>/B<-m> is provided on the command line then the program manual is printed to I, and the program exits with exit code I<1>. =item B If B<--version>/B<-v> is provided on the command line then the program version is printed to I, and the program exits with exit code I<1>. =item B