view release on metacpan or  search on metacpan

lib/Class/Usul/Functions.pm  view on Meta::CPAN

   # 6.    Default to /tmp
   return  untaint_path( DEFAULT_CONFHOME );
}

sub find_source ($) {
   my $class = shift; my $file = classfile( $class ); my $path;

   for (@INC) {
      $path = abs_path( catfile( $_, $file ) ) and -f $path and return $path;
   }

   return;
}

sub first_char ($) {
   return substr $_[ 0 ], 0, 1;
}

sub fqdn (;$) {
   my $x = shift // hostname; return (gethostbyname( $x ))[ 0 ];
}

sub fullname () {
   my $v = (split m{ \s* , \s * }msx, (get_user()->gecos // q()))[ 0 ];

   $v //= q(); $v =~ s{ [\&] }{}gmx; # Coz af25e158-d0c7-11e3-bdcb-31d9eda79835

   return untaint_cmdline( $v );
}

sub get_cfgfiles ($;$$) {
   my ($appclass, $dirs, $extns) = @_;

   $appclass // throw( Unspecified, [ 'application class' ], level => 2 );
   is_arrayref( $dirs ) or $dirs = [ $dirs || curdir ];

   my $app_pref = app_prefix   $appclass;
   my $appdir   = class2appdir $appclass;
   my $env_pref = env_prefix   $appclass;
   my $suffix   = $ENV{ "${env_pref}_CONFIG_LOCAL_SUFFIX" } // '_local';
   my @paths    = ();

   for my $dir (@{ $dirs }) {
      for my $extn (@{ $extns // [ supported_extensions() ] }) {
         for my $path (map { $_catpath->( $dir, $_ ) } "${app_pref}${extn}",
                       "${appdir}${extn}", "${app_pref}${suffix}${extn}",
                       "${appdir}${suffix}${extn}") {
            -f $path and push @paths, $path;
         }
      }
   }

   return \@paths;
}

sub get_user (;$) {
   my $user = shift; is_win32() and return Class::Null->new;

   defined $user and $user !~ m{ \A \d+ \z }mx and return getpwnam( $user );

   return getpwuid( $user // $UID );
}

sub hex2str (;$) {
   my @a = split m{}mx, shift // q(); my $str = q();

   while (my ($x, $y) = splice @a, 0, 2) { $str .= pack 'C', hex "${x}${y}" }

   return $str;
}

sub home2appldir ($) {
   $_[ 0 ] or return; my $dir = io( $_[ 0 ] );

   $dir = $dir->parent while ($dir ne $dir->parent and $dir !~ m{ lib \z }mx);

   return $dir ne $dir->parent ? $dir->parent : undef;
}

sub io (;@) {
   return File::DataClass::IO->new( @_ );
}

sub is_arrayref (;$) {
   return $_[ 0 ] && ref $_[ 0 ] eq 'ARRAY' ? 1 : 0;
}

sub is_coderef (;$) {
   return $_[ 0 ] && ref $_[ 0 ] eq 'CODE' ? 1 : 0;
}

sub is_hashref (;$) {
   return $_[ 0 ] && ref $_[ 0 ] eq 'HASH' ? 1 : 0;
}

sub is_member (;@) {
   my ($candidate, @args) = @_; $candidate or return;

   is_arrayref $args[ 0 ] and @args = @{ $args[ 0 ] };

   return (first { $_ eq $candidate } @args) ? 1 : 0;
}

sub is_ntfs  () {
   return is_win32() || lc $OSNAME eq 'cygwin' ? 1 : 0;
}

sub is_win32 () {
   return lc $OSNAME eq 'mswin32' ? 1 : 0;
}

sub list_attr_of ($;@) {
   my ($obj, @except) = @_; my $class = blessed $obj;

   ensure_class_loaded( 'Pod::Eventual::Simple' );

   is_member 'new', @except or push @except, 'new';

   return map  { my $attr = $_->[0]; [ @{ $_ }, $obj->$attr ] }
          map  { [ $_->[1], $_->[0], $_get_pod_content_for_attr->( @{ $_ } ) ] }
          grep { $_->[0] ne 'Moo::Object' and not is_member $_->[1], @except }

lib/Class/Usul/Functions.pm  view on Meta::CPAN

   $e = exception $error;

Expose the C<catch> method in the exception
class L<Class::Usul::Exception>. Returns a new error object

=head2 C<find_apphome>

   $directory_path = find_apphome $appclass, $homedir, $extns

Returns the path to the applications home directory. Searches the following:

   # 0.  Pass the directory in (short circuit the search)
   # 1a. Environment variable - for application directory
   # 1b. Environment variable - for config file
   # 2a. Users XDG_DATA_HOME env variable or XDG default share directory
   # 2b. Users home directory - dot file containing shell env variable
   # 2c. Users home directory - dot directory is apphome
   # 3.  Well known path containing shell env file
   # 4.  Default install prefix
   # 5a. Config file found in @INC - underscore as separator
   # 5b. Config file found in @INC - dash as separator
   # 6.  Default to /tmp

=head2 C<find_source>

   $path = find_source $module_name;

Find absolute path to the source code for the given module

=head2 C<first_char>

   $single_char = first_char $some_string;

Returns the first character of C<$string>

=head2 C<fqdn>

   $domain_name = fqdn $hostname;

Call C<gethostbyname> on the supplied hostname whist defaults to this host

=head2 C<fullname>

   $fullname = fullname;

Returns the untainted first sub field from the gecos attribute of the
object returned by a call to L</get_user>. Returns the null string if
the gecos attribute value is false

=head2 C<get_cfgfiles>

   $paths = get_cfgfiles $appclass, $dirs, $extns

Returns an array ref of configurations file paths for the application

=head2 C<get_user>

   $user_object = get_user $optional_uid_or_name;

Returns the user object from a call to either C<getpwuid> or C<getpwnam>
depending on whether an integer or a string was passed. The L<User::pwent>
package is loaded so objects are returned. On MSWin32 systems returns an
instance of L<Class::Null>.  Defaults to the current uid but will lookup the
supplied uid if provided

=head2 C<hex2str>

   $string = hex2str $pairs_of_hex_digits;

Converts the pairs of hex digits into a string of characters

=head2 C<home2appldir>

   $appldir = home2appldir $home_dir;

Strips the trailing C<lib/my_package> from the supplied directory path

=head2 C<io>

   $io_object_ref = io $path_to_file_or_directory;

Returns a L<File::DataClass::IO> object reference

=head2 C<is_arrayref>

   $bool = is_arrayref $scalar_variable

Tests to see if the scalar variable is an array ref

=head2 C<is_coderef>

   $bool = is_coderef $scalar_variable

Tests to see if the scalar variable is a code ref

=head2 C<is_hashref>

   $bool = is_hashref $scalar_variable

Tests to see if the scalar variable is a hash ref

=head2 C<is_member>

   $bool = is_member 'test_value', qw( a_value test_value b_value );

Tests to see if the first parameter is present in the list of
remaining parameters

=head2 C<is_ntfs>

   $bool = is_ntfs;

Returns true if L</is_win32> is true or the C<$OSNAME> is
L<cygwin|File::DataClass::Constants/CYGWIN>

=head2 C<is_win32>

   $bool = is_win32;

Returns true if the C<$OSNAME> is