view release on metacpan or  search on metacpan

lib/ChordPro/Output/Common.pm  view on Meta::CPAN

    }

    # Sort.
    my $i = -1;
    use Unicode::Collate;
    my $collator = Unicode::Collate->new;
    my $srt =
      "sub { " .
      join( " or ",
	    map { $i++;
		  my ( $rev, $f ) = /^([-+]*)(.*)/;
		  my $num = $rev =~ s/\+//g;
		  my ( $a, $b ) = $rev =~ /-/ ? qw( b a ) : qw( a b );
		  my $l = "\$$a"."->[$i]";
		  my $r = "\$$b"."->[$i]";
		  warn("F: $f, N: $num, R: $rev\n") if PODBG;
		  $num ? "$l <=> $r" : "\$collator->cmp( $l, $r )"
	       }
		@{$ctl->{fields}} ) .
      " }";
    warn("SRT; $srt\n") if PODBG;
    $srt = eval $srt or die($@);
    @book =
      sort $srt
      map { my $t = $_;
	    [ ( map { demarkup(lc(  ( index($_,"sort") && is_arrayref($t->{meta}->{"sort$_"})
				      ? $t->{meta}->{"sort$_"}->[0]
				      : undef ) //
				   $t->{meta}->{$_}->[0] //
				   "")) }
		    @fields ),
	      $_ ] }
	  @book;

    return \@book;
}
push( @EXPORT_OK, 'prep_outlines' );

sub encode_html {
    my $text = shift;
    return "" unless defined $text;
    $text =~ s/&/&amp;/g;
    $text =~ s/</&lt;/g;
    $text =~ s/>/&gt;/g;
    $text =~ s/"/&quot;/g;
    $text =~ s/'/&#39;/g;
    $text;
}

push( @EXPORT_OK, 'encode_html' );

# Make a data: URI (string) from an external source.
# This is mostly intended for images.
# Since ABC generated SVG can contain multiple images, this function
# can be called in list context to get all the images.
# In scalar context, it returns the first (or only) image.

sub encode_percent {
    my ( $str ) = @_;
    require URI::Escape;
    return URI::Escape::uri_escape_utf8($str);
}

sub mimedata {
    my ( $src, $mimetype ) = @_;

    warn( "mimedata: \"$src\"",
	  $mimetype ? " $mimetype" : "",
	  "\n" ) if $config->{debug}->{images};
    my $data = File::LoadLines::loadblob($src);
    if ( $mimetype ) {
	$mimetype = lc $mimetype;
    }
    else {
	$mimetype = ChordPro::Utils::_detect_image_format($data)
	  || Carp::croak("Unrecognized imge data in \"$src\"");
    }

    unless ( $mimetype =~ m;^(image|text)/.*; ) {
	state $mimetypes =
	  { png  => 'image/png',
	    jpg  => 'image/jpeg',
	    jpeg => 'image/jpeg',
	    gif  => 'image/gif',
	    svg  => 'image/svg+xml',
	    css  => 'text/css',
	  };
	Carp::croak( "Unhandled MIME type \"$mimetype\"" )
	    unless $mimetypes->{$mimetype};
	$mimetype = $mimetypes->{$mimetype};
    }

    my @img;			# there can be more than one
    if ( $mimetype =~/svg/ ) {
	# There may be several images. Split them.
	@img = split( /\<\/svg\>[\n\r]*\<svg/, $data );
	$img[$_] .= "</svg>" for 0..$#img-1;
	$img[$_] = "<svg" . $img[$_] for 1..$#img;
    }
    else {
	@img = ( $data );
    }

    use MIME::Base64;
    # Emit as individual images.
    for my $img ( @img ) {
	if ( $mimetype =~ m;(text/|/svg); ) {
	    $img = "data:$mimetype,". encode_percent($img);
	    warn("mimedata: $mimetype, ", length($img), " bytes\n")
	      if $config->{debug}->{images};
	}
	else {
	    $img = encode_utf8($img) if $mimetype =~ /svg/;
	    $img = "data:$mimetype;base64,". encode_base64( $img, '' );
	    warn("mimedata: $mimetype, ", length($img), " bytes\n")
	      if $config->{debug}->{images};
	}
	if ( @img > 1 && !wantarray ) {
	    Carp::carp( "Warning: Ignoring ",
			plural( @img-1, " excess SVG image" ));
	}