[Bps-public-commit] rt-extension-announce branch, support-html-content-as-banner, created. 1.00-4-gf9d3cd0

Craig Kaiser craig at bestpractical.com
Thu Aug 29 14:54:37 EDT 2019


The branch, support-html-content-as-banner has been created
        at  f9d3cd0f0627a933dfd8460861a0d46b122dd0e7 (commit)

- Log -----------------------------------------------------------------
commit 345ed4178e66c13aad14b4cd25de2c8d53833455
Author: Craig Kaiser <craig at bestpractical.com>
Date:   Mon Aug 19 14:49:55 2019 -0400

    Update Module::Install

diff --git a/META.yml b/META.yml
index 236bbfe..83d7405 100644
--- a/META.yml
+++ b/META.yml
@@ -8,7 +8,7 @@ configure_requires:
   ExtUtils::MakeMaker: 6.59
 distribution_type: module
 dynamic_config: 1
-generated_by: 'Module::Install version 1.12'
+generated_by: 'Module::Install version 1.19'
 license: gpl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -26,6 +26,6 @@ requires:
 resources:
   license: http://opensource.org/licenses/gpl-license.php
   repository: https://github.com/bestpractical/rt-extension-announce
-version: '1.00'
-x_module_install_rtx_version: '0.36'
+version: '1.01'
+x_module_install_rtx_version: '0.40'
 x_requires_rt: 4.0.0
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 5460dd5..7ba98c2 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -31,7 +31,7 @@ BEGIN {
 	# This is not enforced yet, but will be some time in the next few
 	# releases once we can make sure it won't clash with custom
 	# Module::Install extensions.
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 
 	# Storage for the pseudo-singleton
 	$MAIN    = undef;
@@ -244,6 +244,8 @@ sub new {
 	}
 	return $args{_self} if $args{_self};
 
+	$base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS';
+
 	$args{dispatch} ||= 'Admin';
 	$args{prefix}   ||= 'inc';
 	$args{author}   ||= ($^O eq 'VMS' ? '_author' : '.author');
@@ -322,7 +324,7 @@ sub find_extensions {
 	my ($self, $path) = @_;
 
 	my @found;
-	File::Find::find( sub {
+	File::Find::find( {no_chdir => 1, wanted => sub {
 		my $file = $File::Find::name;
 		return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
 		my $subpath = $1;
@@ -336,7 +338,7 @@ sub find_extensions {
 		# correctly.  Otherwise, root through the file to locate the case-preserved
 		# version of the package name.
 		if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
-			my $content = Module::Install::_read($subpath . '.pm');
+			my $content = Module::Install::_read($File::Find::name);
 			my $in_pod  = 0;
 			foreach ( split /\n/, $content ) {
 				$in_pod = 1 if /^=\w/;
@@ -351,7 +353,7 @@ sub find_extensions {
 		}
 
 		push @found, [ $file, $pkg ];
-	}, $path ) if -d $path;
+	}}, $path ) if -d $path;
 
 	@found;
 }
@@ -373,24 +375,14 @@ sub _caller {
 	return $call;
 }
 
-# Done in evals to avoid confusing Perl::MinimumVersion
-eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
 sub _read {
 	local *FH;
 	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+	binmode FH;
 	my $string = do { local $/; <FH> };
 	close FH or die "close($_[0]): $!";
 	return $string;
 }
-END_NEW
-sub _read {
-	local *FH;
-	open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
-	my $string = do { local $/; <FH> };
-	close FH or die "close($_[0]): $!";
-	return $string;
-}
-END_OLD
 
 sub _readperl {
 	my $string = Module::Install::_read($_[0]);
@@ -411,26 +403,15 @@ sub _readpod {
 	return $string;
 }
 
-# Done in evals to avoid confusing Perl::MinimumVersion
-eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
 sub _write {
 	local *FH;
 	open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+	binmode FH;
 	foreach ( 1 .. $#_ ) {
 		print FH $_[$_] or die "print($_[0]): $!";
 	}
 	close FH or die "close($_[0]): $!";
 }
-END_NEW
-sub _write {
-	local *FH;
-	open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
-	foreach ( 1 .. $#_ ) {
-		print FH $_[$_] or die "print($_[0]): $!";
-	}
-	close FH or die "close($_[0]): $!";
-}
-END_OLD
 
 # _version is for processing module versions (eg, 1.03_05) not
 # Perl versions (eg, 5.8.1).
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index f9bf5de..9fa42c2 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
 use strict 'vars';
 use vars qw{$VERSION};
 BEGIN {
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 }
 
 # Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index b4e5e3b..d65c753 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -8,7 +8,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -121,6 +121,15 @@ END_C
 # Can we locate a (the) C compiler
 sub can_cc {
 	my $self   = shift;
+
+	if ($^O eq 'VMS') {
+		require ExtUtils::CBuilder;
+		my $builder = ExtUtils::CBuilder->new(
+		quiet => 1,
+		);
+		return $builder->have_compiler;
+	}
+
 	my @chunks = split(/ /, $Config::Config{cc}) or return;
 
 	# $Config{cc} may contain args; try to find out the program part
@@ -151,4 +160,4 @@ if ( $^O eq 'cygwin' ) {
 
 __END__
 
-#line 236
+#line 245
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 54f14fb..3072b08 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
index 7224cff..13fdcd0 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 81cddd5..13a4464 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 2c66b1e..11bf971 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 73e7245..7cad529 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
 
 use Module::Install::Base;
 use base 'Module::Install::Base';
-our $VERSION = '0.36';
+our $VERSION = '0.40';
 
 use FindBin;
 use File::Glob     ();
@@ -37,6 +37,13 @@ sub RTx {
     }
     $self->add_metadata("x_module_install_rtx_version", $VERSION );
 
+    my $installdirs = $ENV{INSTALLDIRS};
+    for ( @ARGV ) {
+        if ( /INSTALLDIRS=(.*)/ ) {
+            $installdirs = $1;
+        }
+    }
+
     # Try to find RT.pm
     my @prefixes = qw( /opt /usr/local /home /usr /sw /usr/share/request-tracker4);
     $ENV{RTHOME} =~ s{/RT\.pm$}{} if defined $ENV{RTHOME};
@@ -71,7 +78,13 @@ sub RTx {
 
     # Installation locations
     my %path;
-    $path{$_} = $RT::LocalPluginPath . "/$name/$_"
+    my $plugin_path;
+    if ( $installdirs && $installdirs eq 'vendor' ) {
+        $plugin_path = $RT::PluginPath;
+    } else {
+        $plugin_path = $RT::LocalPluginPath;
+    }
+    $path{$_} = $plugin_path . "/$name/$_"
         foreach @DIRS;
 
     # Copy RT 4.2.0 static files into NoAuth; insufficient for
@@ -85,7 +98,7 @@ sub RTx {
     my %index = map { $_ => 1 } @INDEX_DIRS;
     $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS;
 
-    my $args = join ', ', map "q($_)", map { ($_, $path{$_}) }
+    my $args = join ', ', map "q($_)", map { ($_, "\$(DESTDIR)$path{$_}") }
         sort keys %path;
 
     printf "%-10s => %s\n", $_, $path{$_} for sort keys %path;
@@ -100,11 +113,29 @@ lexicons ::
 .
     }
 
+    my $remove_files;
+    if( $extra_args->{'remove_files'} ){
+        $self->include('Module::Install::RTx::Remove');
+        our @remove_files;
+        eval { require "etc/upgrade/remove_files" }
+          or print "No remove file located, no files to remove\n";
+        $remove_files = join ",", map {"q(\$(DESTDIR)$plugin_path/$name/$_)"} @remove_files;
+    }
+
     $self->include('Module::Install::RTx::Runtime') if $self->admin;
     $self->include_deps( 'YAML::Tiny', 0 ) if $self->admin;
     my $postamble = << ".";
 install ::
 \t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxPlugin()"
+.
+
+    if( $remove_files ){
+        $postamble .= << ".";
+\t\$(NOECHO) \$(PERL) -MModule::Install::RTx::Remove -e \"RTxRemove([$remove_files])\"
+.
+    }
+
+    $postamble .= << ".";
 \t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
 .
 
@@ -123,7 +154,7 @@ install ::
         $has_etc{acl}++;
     }
     if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
-    if ( grep { /\d+\.\d+(\.\d+)?.*$/ } glob('etc/upgrade/*.*') ) {
+    if ( grep { /\d+\.\d+\.\d+.*$/ } glob('etc/upgrade/*.*.*') ) {
         $has_etc{upgrade}++;
     }
 
@@ -131,6 +162,7 @@ install ::
     if ( $path{lib} ) {
         $self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
         $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
+        $self->makemaker_args( INSTALLVENDORLIB => $path{'lib'} )
     } else {
         $self->makemaker_args( PM => { "" => "" }, );
     }
@@ -139,6 +171,13 @@ install ::
     $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
     $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
 
+    # INSTALLDIRS=vendor should install manpages into /usr/share/man.
+    # That is the default path in most distributions. Need input from
+    # Redhat, Centos etc.
+    $self->makemaker_args( INSTALLVENDORMAN1DIR => "/usr/share/man/man1" );
+    $self->makemaker_args( INSTALLVENDORMAN3DIR => "/usr/share/man/man3" );
+    $self->makemaker_args( INSTALLVENDORARCH => "/usr/share/man" );
+
     if (%has_etc) {
         print "For first-time installation, type 'make initdb'.\n";
         my $initdb = '';
@@ -258,4 +297,4 @@ sub _load_rt_handle {
 
 __END__
 
-#line 390
+#line 468
diff --git a/inc/Module/Install/RTx/Runtime.pm b/inc/Module/Install/RTx/Runtime.pm
index 937949f..ae07502 100644
--- a/inc/Module/Install/RTx/Runtime.pm
+++ b/inc/Module/Install/RTx/Runtime.pm
@@ -33,6 +33,7 @@ sub RTxDatabase {
 
     my $lib_path = File::Basename::dirname($INC{'RT.pm'});
     my @args = (
+        "-I.",
         "-Ilib",
         "-I$RT::LocalLibPath",
         "-I$lib_path",
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
index b5e03c3..3738232 100644
--- a/inc/Module/Install/ReadmeFromPod.pm
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -7,12 +7,41 @@ use warnings;
 use base qw(Module::Install::Base);
 use vars qw($VERSION);
 
-$VERSION = '0.22';
+$VERSION = '0.30';
+
+{
+
+    # these aren't defined until after _require_admin is run, so
+    # define them so prototypes are available during compilation.
+    sub io;
+    sub capture(&;@);
+
+#line 28
+
+    my $done = 0;
+
+    sub _require_admin {
+
+	# do this once to avoid redefinition warnings from IO::All
+	return if $done;
+
+	require IO::All;
+	IO::All->import( '-binary' );
+
+	require Capture::Tiny;
+	Capture::Tiny->import ( 'capture' );
+
+	return;
+    }
+
+}
 
 sub readme_from {
   my $self = shift;
   return unless $self->is_admin;
 
+  _require_admin;
+
   # Input file
   my $in_file  = shift || $self->_all_from
     or die "Can't determine file to make readme_from";
@@ -50,6 +79,8 @@ sub readme_from {
     $out_file = $self->_readme_htm($in_file, $out_file, $options);
   } elsif ($format eq 'man') {
     $out_file = $self->_readme_man($in_file, $out_file, $options);
+  } elsif ($format eq 'md') {
+    $out_file = $self->_readme_md($in_file, $out_file, $options);
   } elsif ($format eq 'pdf') {
     $out_file = $self->_readme_pdf($in_file, $out_file, $options);
   }
@@ -67,10 +98,10 @@ sub _readme_txt {
   $out_file ||= 'README';
   require Pod::Text;
   my $parser = Pod::Text->new( @$options );
-  open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+  my $io = io->file($out_file)->open(">");
+  my $out_fh = $io->io_handle;
   $parser->output_fh( *$out_fh );
   $parser->parse_file( $in_file );
-  close $out_fh;
   return $out_file;
 }
 
@@ -79,11 +110,14 @@ sub _readme_htm {
   my ($self, $in_file, $out_file, $options) = @_;
   $out_file ||= 'README.htm';
   require Pod::Html;
-  Pod::Html::pod2html(
-    "--infile=$in_file",
-    "--outfile=$out_file",
-    @$options,
-  );
+  my ($o) = capture {
+    Pod::Html::pod2html(
+      "--infile=$in_file",
+      "--outfile=-",
+      @$options,
+    );
+  };
+  io->file($out_file)->print($o);
   # Remove temporary files if needed
   for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') {
     if (-e $file) {
@@ -99,7 +133,10 @@ sub _readme_man {
   $out_file ||= 'README.1';
   require Pod::Man;
   my $parser = Pod::Man->new( @$options );
-  $parser->parse_from_file($in_file, $out_file);
+  my $io = io->file($out_file)->open(">");
+  my $out_fh = $io->io_handle;
+  $parser->output_fh( *$out_fh );
+  $parser->parse_file( $in_file );
   return $out_file;
 }
 
@@ -111,11 +148,20 @@ sub _readme_pdf {
     or die "Could not generate $out_file because pod2pdf could not be found\n";
   my $parser = App::pod2pdf->new( @$options );
   $parser->parse_from_file($in_file);
-  open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
-  select $out_fh;
-  $parser->output;
-  select STDOUT;
-  close $out_fh;
+  my ($o) = capture { $parser->output };
+  io->file($out_file)->print($o);
+  return $out_file;
+}
+
+sub _readme_md {
+  my ($self, $in_file, $out_file, $options) = @_;
+  $out_file ||= 'README.md';
+  require Pod::Markdown;
+  my $parser = Pod::Markdown->new( @$options );
+  my $io = io->file($out_file)->open(">");
+  my $out_fh = $io->io_handle;
+  $parser->output_fh( *$out_fh );
+  $parser->parse_file( $in_file );
   return $out_file;
 }
 
@@ -134,5 +180,5 @@ sub _all_from {
 
 __END__
 
-#line 254
+#line 316
 
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index e48c32d..f7aa615 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 409ef40..2db861a 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '1.12';
+	$VERSION = '1.19';
 	@ISA     = qw{Module::Install::Base};
 	$ISCORE  = 1;
 }
diff --git a/inc/YAML/Tiny.pm b/inc/YAML/Tiny.pm
index 1be0cb1..fb157a6 100644
--- a/inc/YAML/Tiny.pm
+++ b/inc/YAML/Tiny.pm
@@ -2,16 +2,12 @@
 use 5.008001; # sane UTF-8 support
 use strict;
 use warnings;
-package YAML::Tiny;
-BEGIN {
-  $YAML::Tiny::AUTHORITY = 'cpan:ADAMK';
-}
-# git description: v1.61-3-g0a82466
-$YAML::Tiny::VERSION = '1.62';
+package YAML::Tiny; # git description: v1.72-7-g8682f63
 # XXX-INGY is 5.8.1 too old/broken for utf8?
 # XXX-XDG Lancaster consensus was that it was sufficient until
 # proven otherwise
 
+our $VERSION = '1.73';
 
 #####################################################################
 # The YAML::Tiny API.
@@ -300,10 +296,11 @@ Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
             }
         }
     };
-    if ( ref $@ eq 'SCALAR' ) {
-        $self->_error(${$@});
-    } elsif ( $@ ) {
-        $self->_error($@);
+    my $err = $@;
+    if ( ref $err eq 'SCALAR' ) {
+        $self->_error(${$err});
+    } elsif ( $err ) {
+        $self->_error($err);
     }
 
     return $self;
@@ -377,7 +374,7 @@ sub _load_scalar {
     while ( @$lines ) {
         $lines->[0] =~ /^(\s*)/;
         last unless length($1) >= $indent->[-1];
-        push @multiline, substr(shift(@$lines), length($1));
+        push @multiline, substr(shift(@$lines), $indent->[-1]);
     }
 
     my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
@@ -515,6 +512,10 @@ sub _load_hash {
             die \"YAML::Tiny failed to classify line '$lines->[0]'";
         }
 
+        if ( exists $hash->{$key} ) {
+            warn "YAML::Tiny found a duplicate key '$key' in line '$lines->[0]'";
+        }
+
         # Do we have a value?
         if ( length $lines->[0] ) {
             # Yes
@@ -569,10 +570,8 @@ sub _dump_file {
     if ( _can_flock() ) {
         # Open without truncation (truncate comes after lock)
         my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT();
-        sysopen( $fh, $file, $flags );
-        unless ( $fh ) {
-            $self->_error("Failed to open file '$file' for writing: $!");
-        }
+        sysopen( $fh, $file, $flags )
+            or $self->_error("Failed to open file '$file' for writing: $!");
 
         # Use no translation and strict UTF-8
         binmode( $fh, ":raw:encoding(UTF-8)");
@@ -828,9 +827,10 @@ sub _can_flock {
 #####################################################################
 # Use Scalar::Util if possible, otherwise emulate it
 
+use Scalar::Util ();
 BEGIN {
     local $@;
-    if ( eval { require Scalar::Util; Scalar::Util->VERSION(1.18); } ) {
+    if ( eval { Scalar::Util->VERSION(1.18); } ) {
         *refaddr = *Scalar::Util::refaddr;
     }
     else {
@@ -852,8 +852,7 @@ END_PERL
     }
 }
 
-
-
+delete $YAML::Tiny::{refaddr};
 
 1;
 
@@ -870,4 +869,4 @@ END_PERL
 
 __END__
 
-#line 1488
+#line 1487
diff --git a/inc/unicore/Name.pm b/inc/unicore/Name.pm
deleted file mode 100644
index d72eb6e..0000000
--- a/inc/unicore/Name.pm
+++ /dev/null
@@ -1,417 +0,0 @@
-#line 1
-# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
-# This file is machine-generated by lib/unicore/mktables from the Unicode
-# database, Version 6.3.0.  Any changes made here will be lost!
-
-
-# !!!!!!!   INTERNAL PERL USE ONLY   !!!!!!!
-# This file is for internal use by core Perl only.  The format and even the
-# name or existence of this file are subject to change without notice.  Don't
-# use it directly.  Use Unicode::UCD to access the Unicode character data
-# base.
-
-
-package charnames;
-
-# This module contains machine-generated tables and code for the
-# algorithmically-determinable Unicode character names.  The following
-# routines can be used to translate between name and code point and vice versa
-
-{ # Closure
-
-    # Matches legal code point.  4-6 hex numbers, If there are 6, the first
-    # two must be 10; if there are 5, the first must not be a 0.  Written this
-    # way to decrease backtracking.  The first regex allows the code point to
-    # be at the end of a word, but to work properly, the word shouldn't end
-    # with a valid hex character.  The second one won't match a code point at
-    # the end of a word, and doesn't have the run-on issue
-    my $run_on_code_point_re = qr/(?^aax: (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b)/;
-    my $code_point_re = qr/(?^aa:\b(?^aax: (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b))/;
-
-    # In the following hash, the keys are the bases of names which include
-    # the code point in the name, like CJK UNIFIED IDEOGRAPH-4E01.  The value
-    # of each key is another hash which is used to get the low and high ends
-    # for each range of code points that apply to the name.
-    my %names_ending_in_code_point = (
-'CJK COMPATIBILITY IDEOGRAPH' => 
-{
-'high' => 
-[
-64109,
-64217,
-195101,
-],
-'low' => 
-[
-63744,
-64112,
-194560,
-],
-},
-'CJK UNIFIED IDEOGRAPH' => 
-{
-'high' => 
-[
-19893,
-40908,
-173782,
-177972,
-178205,
-],
-'low' => 
-[
-13312,
-19968,
-131072,
-173824,
-177984,
-],
-},
-
-    );
-
-    # The following hash is a copy of the previous one, except is for loose
-    # matching, so each name has blanks and dashes squeezed out
-    my %loose_names_ending_in_code_point = (
-'CJKCOMPATIBILITYIDEOGRAPH' => 
-{
-'high' => 
-[
-64109,
-64217,
-195101,
-],
-'low' => 
-[
-63744,
-64112,
-194560,
-],
-},
-'CJKUNIFIEDIDEOGRAPH' => 
-{
-'high' => 
-[
-19893,
-40908,
-173782,
-177972,
-178205,
-],
-'low' => 
-[
-13312,
-19968,
-131072,
-173824,
-177984,
-],
-},
-
-    );
-
-    # And the following array gives the inverse mapping from code points to
-    # names.  Lowest code points are first
-    my @code_points_ending_in_code_point = (
-
-{
-'high' => 19893,
-'low' => 13312,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 40908,
-'low' => 19968,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 64109,
-'low' => 63744,
-'name' => 'CJK COMPATIBILITY IDEOGRAPH',
-},
-{
-'high' => 64217,
-'low' => 64112,
-'name' => 'CJK COMPATIBILITY IDEOGRAPH',
-},
-{
-'high' => 173782,
-'low' => 131072,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 177972,
-'low' => 173824,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 178205,
-'low' => 177984,
-'name' => 'CJK UNIFIED IDEOGRAPH',
-},
-{
-'high' => 195101,
-'low' => 194560,
-'name' => 'CJK COMPATIBILITY IDEOGRAPH',
-},
-,
-
-    );
-
-    # Convert from code point to Jamo short name for use in composing Hangul
-    # syllable names
-    my %Jamo = (
-4352 => 'G',
-4353 => 'GG',
-4354 => 'N',
-4355 => 'D',
-4356 => 'DD',
-4357 => 'R',
-4358 => 'M',
-4359 => 'B',
-4360 => 'BB',
-4361 => 'S',
-4362 => 'SS',
-4363 => '',
-4364 => 'J',
-4365 => 'JJ',
-4366 => 'C',
-4367 => 'K',
-4368 => 'T',
-4369 => 'P',
-4370 => 'H',
-4449 => 'A',
-4450 => 'AE',
-4451 => 'YA',
-4452 => 'YAE',
-4453 => 'EO',
-4454 => 'E',
-4455 => 'YEO',
-4456 => 'YE',
-4457 => 'O',
-4458 => 'WA',
-4459 => 'WAE',
-4460 => 'OE',
-4461 => 'YO',
-4462 => 'U',
-4463 => 'WEO',
-4464 => 'WE',
-4465 => 'WI',
-4466 => 'YU',
-4467 => 'EU',
-4468 => 'YI',
-4469 => 'I',
-4520 => 'G',
-4521 => 'GG',
-4522 => 'GS',
-4523 => 'N',
-4524 => 'NJ',
-4525 => 'NH',
-4526 => 'D',
-4527 => 'L',
-4528 => 'LG',
-4529 => 'LM',
-4530 => 'LB',
-4531 => 'LS',
-4532 => 'LT',
-4533 => 'LP',
-4534 => 'LH',
-4535 => 'M',
-4536 => 'B',
-4537 => 'BS',
-4538 => 'S',
-4539 => 'SS',
-4540 => 'NG',
-4541 => 'J',
-4542 => 'C',
-4543 => 'K',
-4544 => 'T',
-4545 => 'P',
-4546 => 'H',
-
-    );
-
-    # Leading consonant (can be null)
-    my %Jamo_L = (
-'' => 11,
-'B' => 7,
-'BB' => 8,
-'C' => 14,
-'D' => 3,
-'DD' => 4,
-'G' => 0,
-'GG' => 1,
-'H' => 18,
-'J' => 12,
-'JJ' => 13,
-'K' => 15,
-'M' => 6,
-'N' => 2,
-'P' => 17,
-'R' => 5,
-'S' => 9,
-'SS' => 10,
-'T' => 16,
-
-    );
-
-    # Vowel
-    my %Jamo_V = (
-'A' => 0,
-'AE' => 1,
-'E' => 5,
-'EO' => 4,
-'EU' => 18,
-'I' => 20,
-'O' => 8,
-'OE' => 11,
-'U' => 13,
-'WA' => 9,
-'WAE' => 10,
-'WE' => 15,
-'WEO' => 14,
-'WI' => 16,
-'YA' => 2,
-'YAE' => 3,
-'YE' => 7,
-'YEO' => 6,
-'YI' => 19,
-'YO' => 12,
-'YU' => 17,
-
-    );
-
-    # Optional trailing consonant
-    my %Jamo_T = (
-'B' => 17,
-'BS' => 18,
-'C' => 23,
-'D' => 7,
-'G' => 1,
-'GG' => 2,
-'GS' => 3,
-'H' => 27,
-'J' => 22,
-'K' => 24,
-'L' => 8,
-'LB' => 11,
-'LG' => 9,
-'LH' => 15,
-'LM' => 10,
-'LP' => 14,
-'LS' => 12,
-'LT' => 13,
-'M' => 16,
-'N' => 4,
-'NG' => 21,
-'NH' => 6,
-'NJ' => 5,
-'P' => 26,
-'S' => 19,
-'SS' => 20,
-'T' => 25,
-
-    );
-
-    # Computed re that splits up a Hangul name into LVT or LV syllables
-    my $syllable_re = qr/(|B|BB|C|D|DD|G|GG|H|J|JJ|K|M|N|P|R|S|SS|T)(A|AE|E|EO|EU|I|O|OE|U|WA|WAE|WE|WEO|WI|YA|YAE|YE|YEO|YI|YO|YU)(B|BS|C|D|G|GG|GS|H|J|K|L|LB|LG|LH|LM|LP|LS|LT|M|N|NG|NH|NJ|P|S|SS|T)?/;
-
-    my $HANGUL_SYLLABLE = "HANGUL SYLLABLE ";
-    my $loose_HANGUL_SYLLABLE = "HANGULSYLLABLE";
-
-    # These constants names and values were taken from the Unicode standard,
-    # version 5.1, section 3.12.  They are used in conjunction with Hangul
-    # syllables
-    my $SBase = 0xAC00;
-    my $LBase = 0x1100;
-    my $VBase = 0x1161;
-    my $TBase = 0x11A7;
-    my $SCount = 11172;
-    my $LCount = 19;
-    my $VCount = 21;
-    my $TCount = 28;
-    my $NCount = $VCount * $TCount;
-
-    sub name_to_code_point_special {
-        my ($name, $loose) = @_;
-
-        # Returns undef if not one of the specially handled names; otherwise
-        # returns the code point equivalent to the input name
-        # $loose is non-zero if to use loose matching, 'name' in that case
-        # must be input as upper case with all blanks and dashes squeezed out.
-
-        if ((! $loose && $name =~ s/$HANGUL_SYLLABLE//)
-            || ($loose && $name =~ s/$loose_HANGUL_SYLLABLE//))
-        {
-            return if $name !~ qr/^$syllable_re$/;
-            my $L = $Jamo_L{$1};
-            my $V = $Jamo_V{$2};
-            my $T = (defined $3) ? $Jamo_T{$3} : 0;
-            return ($L * $VCount + $V) * $TCount + $T + $SBase;
-        }
-
-        # Name must end in 'code_point' for this to handle.
-        return if (($loose && $name !~ /^ (.*?) ($run_on_code_point_re) $/x)
-                   || (! $loose && $name !~ /^ (.*) ($code_point_re) $/x));
-
-        my $base = $1;
-        my $code_point = CORE::hex $2;
-        my $names_ref;
-
-        if ($loose) {
-            $names_ref = \%loose_names_ending_in_code_point;
-        }
-        else {
-            return if $base !~ s/-$//;
-            $names_ref = \%names_ending_in_code_point;
-        }
-
-        # Name must be one of the ones which has the code point in it.
-        return if ! $names_ref->{$base};
-
-        # Look through the list of ranges that apply to this name to see if
-        # the code point is in one of them.
-        for (my $i = 0; $i < scalar @{$names_ref->{$base}{'low'}}; $i++) {
-            return if $names_ref->{$base}{'low'}->[$i] > $code_point;
-            next if $names_ref->{$base}{'high'}->[$i] < $code_point;
-
-            # Here, the code point is in the range.
-            return $code_point;
-        }
-
-        # Here, looked like the name had a code point number in it, but
-        # did not match one of the valid ones.
-        return;
-    }
-
-    sub code_point_to_name_special {
-        my $code_point = shift;
-
-        # Returns the name of a code point if algorithmically determinable;
-        # undef if not
-
-        # If in the Hangul range, calculate the name based on Unicode's
-        # algorithm
-        if ($code_point >= $SBase && $code_point <= $SBase + $SCount -1) {
-            use integer;
-            my $SIndex = $code_point - $SBase;
-            my $L = $LBase + $SIndex / $NCount;
-            my $V = $VBase + ($SIndex % $NCount) / $TCount;
-            my $T = $TBase + $SIndex % $TCount;
-            $name = "$HANGUL_SYLLABLE$Jamo{$L}$Jamo{$V}";
-            $name .= $Jamo{$T} if $T != $TBase;
-            return $name;
-        }
-
-        # Look through list of these code points for one in range.
-        foreach my $hash (@code_points_ending_in_code_point) {
-            return if $code_point < $hash->{'low'};
-            if ($code_point <= $hash->{'high'}) {
-                return sprintf("%s-%04X", $hash->{'name'}, $code_point);
-            }
-        }
-        return;            # None found
-    }
-} # End closure
-
-1;

commit ee93d117f97c0f8d001469acfc991b900dc2b297
Author: Craig Kaiser <craig at bestpractical.com>
Date:   Mon Aug 19 14:51:15 2019 -0400

    Add configuration variable to allow HTML content as announce banner

diff --git a/README b/README
index 08fbfde..e7a409e 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     RT-Extension-Announce - Display announcements as a banner on RT pages.
 
 RT VERSION
-    Works with RT 4.0 and 4.2.
+    Works with RT 4.0, 4.2 and 4.4.
 
 INSTALLATION
     perl Makefile.PL
@@ -113,6 +113,10 @@ CONFIGURATION
     Set this to true to show announcements on the self service page as well
     as the regular privileged RT page.
 
+  $RTAnnounceAllowHTML
+    If set to true, the banner content will be set to 'text/html' and allow
+    HTML rendering.
+
 AUTHOR
     Best Practical Solutions, LLC <modules at bestpractical.com>
 
diff --git a/html/Callbacks/RT-Extension-Announce/Elements/PageLayout/BeforeBody b/html/Callbacks/RT-Extension-Announce/Elements/PageLayout/BeforeBody
index 86d8b18..cfd3fee 100644
--- a/html/Callbacks/RT-Extension-Announce/Elements/PageLayout/BeforeBody
+++ b/html/Callbacks/RT-Extension-Announce/Elements/PageLayout/BeforeBody
@@ -67,7 +67,10 @@
   }
   $txns->OrderBy( FIELD => 'Created', ORDER => 'DESC' );
   $txns->RowsPerPage(1);
-  my $content = $txns->First->Content(Type => 'text/plain');
+
+  my $show_html = RT::Config->Get('RTAnnounceAllowHTML') || 0;
+  my $content = $show_html ? $txns->First->Content(Type => 'text/html') : $txns->First->Content(Type => 'text/plain');
+
   if( length $content > $MaxMessageLength ){
     $content = substr($content, 0, $MaxMessageLength);
     # Try to break at a word boundary.
@@ -76,7 +79,11 @@
     $content .= chr(8230); # Ellipsis character
   }
 </%perl>
-<% $content %>
+% if ( $show_html ) {
+  <% $content |n %>
+% } else {
+  <% $content %>
+% }
 %if( $show_ticket_links{$ticket->Id} ){
  (<a class="announcements_detail" href="<% RT->Config->Get('WebPath') %>/Ticket/Display.html?id=<% $ticket->Id %>">more</a>)
 %}
diff --git a/lib/RT/Extension/Announce.pm b/lib/RT/Extension/Announce.pm
index 278ce8d..44bc8c3 100644
--- a/lib/RT/Extension/Announce.pm
+++ b/lib/RT/Extension/Announce.pm
@@ -220,6 +220,10 @@ in your RT_SiteConfig.pm:
 Set this to true to show announcements on the self service page as well as
 the regular privileged RT page.
 
+=head2 C<$RTAnnounceAllowHTML>
+
+If set to true, the banner content will be set to 'text/html' and allow HTML rendering.
+
 =head1 AUTHOR
 
 Best Practical Solutions, LLC E<lt>modules at bestpractical.comE<gt>

commit f9d3cd0f0627a933dfd8460861a0d46b122dd0e7
Author: Craig Kaiser <craig at bestpractical.com>
Date:   Wed Aug 28 09:56:03 2019 -0400

    Allow the number of lines displayed in the RT announce banner to be configured

diff --git a/META.yml b/META.yml
index 83d7405..0b65c8a 100644
--- a/META.yml
+++ b/META.yml
@@ -22,6 +22,7 @@ no_index:
     - static
     - xt
 requires:
+  Mojo::Dom: 0
   perl: 5.8.3
 resources:
   license: http://opensource.org/licenses/gpl-license.php
diff --git a/Makefile.PL b/Makefile.PL
index 52c7822..c4a6850 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -2,6 +2,8 @@ use inc::Module::Install;
 
 RTx 'RT-Extension-Announce';
 
+requires 'Mojo::Dom';
+
 repository('https://github.com/bestpractical/rt-extension-announce');
 
 my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
diff --git a/README b/README
index e7a409e..7eab172 100644
--- a/README
+++ b/README
@@ -117,6 +117,11 @@ CONFIGURATION
     If set to true, the banner content will be set to 'text/html' and allow
     HTML rendering.
 
+  $RTAnnounceLineCountLimit
+    Set the number of lines that should be displayed in the RT announce
+    banner, if the displayed lines exceed the line limit a scroll box
+    feature will be available.
+
 AUTHOR
     Best Practical Solutions, LLC <modules at bestpractical.com>
 
diff --git a/html/Callbacks/RT-Extension-Announce/Elements/PageLayout/BeforeBody b/html/Callbacks/RT-Extension-Announce/Elements/PageLayout/BeforeBody
index cfd3fee..aab35cb 100644
--- a/html/Callbacks/RT-Extension-Announce/Elements/PageLayout/BeforeBody
+++ b/html/Callbacks/RT-Extension-Announce/Elements/PageLayout/BeforeBody
@@ -78,12 +78,62 @@
     $content =~ s/\s+$//g; # Remove trailing space
     $content .= chr(8230); # Ellipsis character
   }
+
+  use Mojo::Dom;
+  my $dom = Mojo::DOM->new( $content );
+
+  my @lines;
+  if ( $show_html ) {
+    for my $line ( split("\n", $dom->all_text ) ) {
+      # We do not care about strings with only white space
+      next unless $line =~ /\S/;
+
+      # Find the HTML element matching our text, not just the text component
+      my $match = $dom->find('*')->grep(sub { $_->all_text =~ /$line/ })->first;
+      next unless $match;
+
+      # We want the HTML string from the component not just the parsed text content
+      push @lines, $match->to_string;
+
+      # Remove this content from our DOM object in case there are duplicate text components
+      $dom = $match->strip;
+    }
+  } else {
+    # Split just on line breaks
+    @lines = split ( "\n", $content );
+  }
+  my $line_count_limit = RT::Config->Get('RTAnnounceLineCountLimit');
+
+  if ( $line_count_limit && scalar @lines > $line_count_limit && $show_html ) {
+    my $dom_ellipsis = Mojo::DOM->new();
+
+    my $count = 0;
+    for my $line ( @lines ) {
+      if ( $count eq $line_count_limit ) {
+        # Placeholder element to be replaced with overflow CSS div
+        $dom_ellipsis = $dom_ellipsis->append_content( '<p id="RTAnnounceOverflowStart">' );
+      }
+      $dom_ellipsis = $dom_ellipsis->append_content( $line );
+      $count = $count + 1;
+    }
+    # Wrap our content in a scrollable div since we have more lines than we want to display
+    $content = $dom_ellipsis->content;
+
+    # Replace our placeholder element with the overflow div
+    $content =~ s/\<p id="RTAnnounceOverflowStart"\>\<\/p\>/\<div class="RTAnnounceBannerOverflow overflow-ellipsis"\>/;
+
+    # Close the overflow div at the end of the content
+    $content .= '</div>';
+  }
+
 </%perl>
+<div class="RTAnnounceScrollable">
 % if ( $show_html ) {
   <% $content |n %>
 % } else {
   <% $content %>
 % }
+</div>
 %if( $show_ticket_links{$ticket->Id} ){
  (<a class="announcements_detail" href="<% RT->Config->Get('WebPath') %>/Ticket/Display.html?id=<% $ticket->Id %>">more</a>)
 %}
diff --git a/lib/RT/Extension/Announce.pm b/lib/RT/Extension/Announce.pm
index 44bc8c3..afdb509 100644
--- a/lib/RT/Extension/Announce.pm
+++ b/lib/RT/Extension/Announce.pm
@@ -224,6 +224,11 @@ the regular privileged RT page.
 
 If set to true, the banner content will be set to 'text/html' and allow HTML rendering.
 
+=head2 C<$RTAnnounceLineCountLimit>
+
+Set the number of lines that should be displayed in the RT announce banner, if the displayed lines exceed
+the line limit a scroll box feature will be available.
+
 =head1 AUTHOR
 
 Best Practical Solutions, LLC E<lt>modules at bestpractical.comE<gt>
diff --git a/static/css/announce.css b/static/css/announce.css
index 022eac9..1052ec5 100644
--- a/static/css/announce.css
+++ b/static/css/announce.css
@@ -82,3 +82,12 @@ table.announce td.date {
   font-size: smaller;
   color: #777;
 }
+
+.RTAnnounceBannerOverflow {
+  height: 0px;
+  white-space: nowrap;
+}
+
+.RTAnnounceScrollable {
+  overflow: auto;
+}

-----------------------------------------------------------------------


More information about the Bps-public-commit mailing list