view release on metacpan or  search on metacpan

lib/ChordPro/Utils.pm  view on Meta::CPAN

#! perl

package ChordPro::Utils;

use v5.26;
use utf8;
use Carp;
use feature qw( signatures );
no warnings "experimental::signatures";
use Ref::Util qw( is_arrayref is_hashref );

use Exporter 'import';
our @EXPORT;
our @EXPORT_OK;
our %EXPORT_TAGS;

use ChordPro::Files;

################ Filenames ################

use File::Glob ( ":bsd_glob" );

# Derived from Path::ExpandTilde.

use constant BSD_GLOB_FLAGS => GLOB_NOCHECK | GLOB_QUOTE | GLOB_TILDE | GLOB_ERR
  # add GLOB_NOCASE as in File::Glob
  | ($^O =~ m/\A(?:MSWin32|VMS|os2|dos|riscos)\z/ ? GLOB_NOCASE : 0);

# File::Glob did not try %USERPROFILE% (set in Windows NT derivatives) for ~ before 5.16
use constant WINDOWS_USERPROFILE => is_msw && $] < 5.016;

sub expand_tilde ( $dir ) {

    return undef unless defined $dir;
    return fn_canonpath($dir) unless $dir =~ m/^~/;

    # Parse path into segments.
    my ( $volume, $directories, $file ) = fn_splitpath( $dir, 1 );
    my @parts = fn_splitdir($directories);
    my $first = shift( @parts );
    return fn_canonpath($dir) unless defined $first;

    # Expand first segment.
    my $expanded;
    if ( WINDOWS_USERPROFILE and $first eq '~' ) {
	$expanded = $ENV{HOME} || $ENV{USERPROFILE};
    }
    else {
	( my $pattern = $first ) =~ s/([\\*?{[])/\\$1/g;
	($expanded) = bsd_glob( $pattern, BSD_GLOB_FLAGS );
	croak( "Failed to expand $first: $!") if GLOB_ERROR;
    }
    return fn_canonpath($dir)
      if !defined $expanded or $expanded eq $first;

    # Replace first segment with new path.
    ( $volume, $directories ) = fn_splitpath( $expanded, 1 );
    $directories = fn_catdir( $directories, @parts );
    return fn_catpath($volume, $directories, $file);
}

push( @EXPORT, 'expand_tilde' );

sub sys ( @cmd ) {
    warn("+ @cmd\n") if $::options->{trace};
    # Use outer defined subroutine, depends on Wx or not.
    my $res = ::sys(@cmd);
    warn( sprintf("=%02x=> @cmd", $res), "\n" ) if $res;
    return $res;
}

lib/ChordPro/Utils.pm  view on Meta::CPAN

}

push( @EXPORT, "fontsize" );

# Dimension allows arbitrary units, and defaults to ref 12.
sub dimension( $size, %sz ) {
    return unless defined $size;
    my $ref;
    if ( ( $ref = $sz{fsize} )
	 && $size =~ /^([.\d]+)(%|e[mx])$/ ) {
	return $ref/100 * $1  if $2 eq '%';
	return $ref     * $1  if $2 eq 'em';
	return $ref/2   * $1  if $2 eq 'ex';
    }
    if ( ( $ref = $sz{width} )
	 && $size =~ /^([.\d]+)(%)$/ ) {
	return $ref/100 * $1  if $2 eq '%';
    }
    if ( $size =~ /^([.\d]+)(p[tx]|[cm]m|in|)$/ ) {
	return $1             if $2 eq 'pt';
	return $1 * 0.75      if $2 eq 'px';
	return $1 * 72 / 2.54 if $2 eq 'cm';
	return $1 * 72 / 25.4 if $2 eq 'mm';
	return $1 * 72        if $2 eq 'in';
	return $1             if $2 eq '';
    }
    $size;			# let someone else croak
}

push( @EXPORT, "dimension" );

# Checking font names against the PDF corefonts.

my %corefonts =
  (
   ( map { lc($_) => $_ }
     "Times-Roman",
     "Times-Bold",
     "Times-Italic",
     "Times-BoldItalic",
     "Helvetica",
     "Helvetica-Bold",
     "Helvetica-Oblique",
     "Helvetica-BoldOblique",
     "Courier",
     "Courier-Bold",
     "Courier-Oblique",
     "Courier-BoldOblique",
     "Symbol",
     "ZapfDingbats" ),
);

sub is_corefont {
    $corefonts{lc $_[0]};
}

push( @EXPORT, "is_corefont" );

# Progress reporting.

use Ref::Util qw(is_coderef);

# Progress can return a false result to allow caller to stop.

sub progress(%args) {
    state $callback;
    state $phase = "";
    state $index = 0;
    state $total = '';
    unless ( %args ) {		# reset
	undef $callback;
	$phase = "";
	$index = 0;
	return;
    }

    $callback = $args{callback} if exists $args{callback};
    return 1 unless $callback;

    if ( exists $args{phase} ) {
	$index = 0 if $phase ne $args{phase};
	$phase = $args{phase};
    }
    if ( exists $args{index} ) {
	$index = $args{index};

	# Use index<0 to only set callback/phase.
	$index = 0, $total = '', return if $index < 0;
    }
    if ( exists $args{total} ) {
	$total = $args{total};
    }

    my $args = { phase => $phase, index => $index, total => $total, %args };

    my $ret = ++$index;
    if ( is_coderef($callback) ) {
	$ret = eval { $callback->(%$args) };
	if ( $@ ) {
	    warn($@);
	    undef $callback;
	}
    }
    else {
	if ( $callback eq "warn" ) {
	    # Simple progress message. Suppress if $index = 0 or total = 1.
	    $callback =
	      '%{index=0||' .
	      '%{total=1||Progress[%{phase}]: %{index}%{total|/%{}}%{msg| - %{}}}' .
	      '}';
	}
	my $msg = ChordPro::Output::Common::fmt_subst
	  ( { meta => $args }, $callback );
	$msg =~ s/\n+$//;
	warn( $msg, "\n" ) if $msg;
    }

    return $ret;
}

push( @EXPORT, "progress" );