ga-pwd

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # ga-pwd
   5 # File ID: b213e514-0d5f-11e6-9cac-fefdb24f8e10
   6 #
   7 # Print name of current directory with user name and/or tilde
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2016– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Long;
  18 use Cwd 'abs_path';
  19
  20 local $| = 1;
  21
  22 our %Opt = (
  23
  24     'help' => 0,
  25     'quiet' => 0,
  26     'verbose' => 0,
  27     'version' => 0,
  28
  29 );
  30
  31 our $progname = $0;
  32 $progname =~ s/^.*\/(.*?)$/$1/;
  33 our $VERSION = '0.1.0';
  34
  35 Getopt::Long::Configure('bundling');
  36 GetOptions(
  37
  38     'help|h' => \$Opt{'help'},
  39     'quiet|q+' => \$Opt{'quiet'},
  40     'verbose|v+' => \$Opt{'verbose'},
  41     'version' => \$Opt{'version'},
  42
  43 ) || die("$progname: Option error. Use -h for help.\n");
  44
  45 $Opt{'verbose'} -= $Opt{'quiet'};
  46 $Opt{'help'} && usage(0);
  47 if ($Opt{'version'}) {
  48     print_version();
  49     exit(0);
  50 }
  51
  52 exit(main());
  53
  54 sub main {
  55     # {{{
  56     my $Retval = 0;
  57     my $abs_path = abs_path('.');
  58     my $home_path = abs_path($ENV{'HOME'});
  59     my $user = getpwuid($<);
  60     chomp(my $hostname = `hostname`);
  61     msg(3, "abs_path = '$abs_path', home_path = '$home_path', user = '$user'");
  62     my $outpath = $abs_path;
  63     $outpath =~ s/^$home_path/~/;
  64     msg(3, "outpath after regexp: '$outpath'");
  65     unless ($outpath =~ /^\/media\//) {
  66         $outpath = "$user\@$hostname:" . $outpath;
  67     }
  68     print("$outpath\n");
  69
  70     return $Retval;
  71     # }}}
  72 } # main()
  73
  74 sub print_version {
  75     # Print program version {{{
  76     print("$progname $VERSION\n");
  77     return;
  78     # }}}
  79 } # print_version()
  80
  81 sub usage {
  82     # Send the help message to stdout {{{
  83     my $Retval = shift;
  84
  85     if ($Opt{'verbose'}) {
  86         print("\n");
  87         print_version();
  88     }
  89     print(<<"END");
  90
  91 Print name of current directory, using the format "user\@host:pwd". Use
  92 the "physical" directory location, ignore symlinks. If the current
  93 directory is below \$HOME, replace the first part with '~'. If current
  94 dir is below /media/, don't print username and hostname.
  95
  96 Usage: $progname [options]
  97
  98 Options:
  99
 100   -h, --help
 101     Show this help.
 102   -q, --quiet
 103     Be more quiet. Can be repeated to increase silence.
 104   -v, --verbose
 105     Increase level of verbosity. Can be repeated.
 106   --version
 107     Print version information.
 108
 109 END
 110     exit($Retval);
 111     # }}}
 112 } # usage()
 113
 114 sub msg {
 115     # Print a status message to stderr based on verbosity level {{{
 116     my ($verbose_level, $Txt) = @_;
 117
 118     if ($Opt{'verbose'} >= $verbose_level) {
 119         print(STDERR "$progname: $Txt\n");
 120     }
 121     return;
 122     # }}}
 123 } # msg()
 124
 125 __END__
 126
 127 # This program is free software; you can redistribute it and/or modify
 128 # it under the terms of the GNU General Public License as published by
 129 # the Free Software Foundation; either version 2 of the License, or (at
 130 # your option) any later version.
 131 #
 132 # This program is distributed in the hope that it will be useful, but
 133 # WITHOUT ANY WARRANTY; without even the implied warranty of
 134 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 135 # See the GNU General Public License for more details.
 136 #
 137 # You should have received a copy of the GNU General Public License
 138 # along with this program.
 139 # If not, see L<http://www.gnu.org/licenses/>.
 140
 141 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :