view release on metacpan or  search on metacpan

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

    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" );

# Common items for property directives ({textsize} etc.).

sub propitems() {
    qw(  chord chorus diagrams footer grid label tab text title toc );
}

sub propitems_re() {
    my $re = join( '|', propitems() );
    qr/(?:$re)/;
}

push( @EXPORT, "propitems_re" );
push( @EXPORT_OK, "propitems" );

# For debugging encoding problems.

sub as( $s ) {
    return "<undef>" unless defined $s;
    $s =~ s{ ( [^\x{20}-\x{7f}] ) }
	   { join( '', map { sprintf '\x{%02x}', ord $_ } split //, $1) }gex;
    return $s;
}

push( @EXPORT_OK, "as" );

sub enumerated( @s ) {
    return "" unless @s;
    my $last = pop(@s);
    my $ret = "";
    $ret .= join(", ", @s) . " and " if @s;
    $ret .= $last;
    return $ret;
}

push( @EXPORT_OK, "enumerated" );

# Determine image type.

sub _detect_image_format( $test ) {

    for ( ref($test) ? $$test : $test ) {
	/^GIF\d\d[a-z]/            and return 'gif';
	/^\xFF\xD8\xFF/            and return 'jpeg';
	/^\x89PNG\x0D\x0A\x1A\x0A/ and return 'png';
	/^\s*P[1-6]/               and return 'pnm';
	/^II\x2A\x00/              and return 'tiff';
	/^MM\x00\x2A/              and return 'tiff';
	/^<svg\s/is                and return 'svg';
    }

    # Not recognized.
    return;
}

sub detect_image_format( $test ) {
    my $format = _detect_image_format($test);

    if ( $format ) {
	return { file_ext => $format, error => "" };
    }
    return { file_ext => "", error => "Unrecognized image type." };
}

push( @EXPORT_OK, "detect_image_format" );

# Transpose types

sub XP_DEFAULT() { 0 }
sub XP_FOLLOW()  { 0 }
sub XP_SHARP()   { 1 }
sub XP_FLAT()    { 2 }
sub XP_KEY()     { 3 }

$EXPORT_TAGS{"xp"} = [ qw( XP_DEFAULT XP_FOLLOW XP_SHARP XP_FLAT XP_KEY ) ];
push( @EXPORT_OK, @{ $EXPORT_TAGS{"xp"} } );

1;