[Bps-public-commit] rt-extension-aws-assets branch sync-utility created. 2b2677bf3c1859a96939b48b09d8bb0ea1e18e2e

[BPS Git Server]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "rt-extension-aws-assets".

The branch, sync-utility has been created
        at  2b2677bf3c1859a96939b48b09d8bb0ea1e18e2e (commit)

- Log -----------------------------------------------------------------
commit 2b2677bf3c1859a96939b48b09d8bb0ea1e18e2e
Author: Jim Brandt <jbrandt at bestpractical.com>
Date:   Tue Feb 6 16:46:19 2024 -0500

    Initial sync utility

diff --git a/.gitignore b/.gitignore
index b5599d3..4c72c95 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,3 +12,4 @@ pod2htm*.tmp
 /MYMETA.*
 /t/tmp
 /xt/tmp
+rt-import-aws-assets
diff --git a/META.yml b/META.yml
index 48f144a..bcc2277 100644
--- a/META.yml
+++ b/META.yml
@@ -24,5 +24,5 @@ resources:
   repository: https://github.com/bestpractical/rt-extension-aws-assets
 version: '0.01'
 x_module_install_rtx_version: '0.43'
-x_requires_rt: 4.4.0
+x_requires_rt: 5.0.0
 x_rt_too_new: 5.2.0
diff --git a/Makefile.PL b/Makefile.PL
index 8a71ee4..4d5c7fd 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -5,8 +5,32 @@ RTx     'RT-Extension-AWS-Assets';
 license 'gpl_2';
 repository 'https://github.com/bestpractical/rt-extension-aws-assets';
 
-requires_rt '4.4.0';
+requires_rt '5.0.0';
 rt_too_new '5.2.0';
 
+my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
+my $lib_path = join( ' ', "$RT::LocalPath/lib", $lp );
+my $bin_path = $RT::BinPath || "$RT::BasePath/bin" || "/opt/rt5/bin";
+
+# Straight from perldoc perlvar
+use Config;
+my $secure_perl_path = $Config{perlpath};
+if ($^O ne 'VMS') {
+    $secure_perl_path .= $Config{_exe}
+        unless $secure_perl_path =~ m/$Config{_exe}$/i;
+}
+
+substitute(
+           {
+        RT_LIB_PATH  => $lib_path,
+        RT_BIN_PATH  => $bin_path,
+        PERL         => $ENV{PERL} || $secure_perl_path,
+    },
+           {
+        sufix => '.in'
+    },
+           qw(bin/rt-import-aws-assets),
+);
+
 sign;
 WriteAll;
diff --git a/bin/rt-import-aws-assets.in b/bin/rt-import-aws-assets.in
new file mode 100644
index 0000000..72cb1b9
--- /dev/null
+++ b/bin/rt-import-aws-assets.in
@@ -0,0 +1,11 @@
+#!/usr/bin/env perl
+### before: #!@PERL@
+
+use strict;
+use warnings;
+
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt5/local/lib /opt/rt5/lib);
+
+use RT::Interface::CLI qw(Init GetCurrentUser);
+my %opt;
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
new file mode 100644
index 0000000..56af7fe
--- /dev/null
+++ b/inc/Module/Install/Substitute.pm
@@ -0,0 +1,131 @@
+#line 1
+package Module::Install::Substitute;
+
+use strict;
+use warnings;
+use 5.008; # I don't care much about earlier versions
+
+use Module::Install::Base;
+our @ISA = qw(Module::Install::Base);
+
+our $VERSION = '0.03';
+
+require File::Temp;
+require File::Spec;
+require Cwd;
+
+#line 89
+
+sub substitute
+{
+	my $self = shift;
+	$self->{__subst} = shift;
+	$self->{__option} = {};
+	if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
+		my $opts = shift;
+		while( my ($k,$v) = each( %$opts ) ) {
+			$self->{__option}->{ lc( $k ) } = $v || '';
+		}
+	}
+	$self->_parse_options;
+
+	my @file = @_;
+	foreach my $f (@file) {
+		$self->_rewrite_file( $f );
+	}
+
+	return;
+}
+
+sub _parse_options
+{
+	my $self = shift;
+	my $cwd = Cwd::getcwd();
+	foreach my $t ( qw(from to) ) {
+        $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
+		my $d = $self->{__option}->{$t};
+		die "Couldn't read directory '$d'" unless -d $d && -r _;
+	}
+}
+
+sub _rewrite_file
+{
+	my ($self, $file) = @_;
+	my $source = File::Spec->catfile( $self->{__option}{from}, $file );
+	$source .= $self->{__option}{sufix} if $self->{__option}{sufix};
+	unless( -f $source && -r _ ) {
+		print STDERR "Couldn't find file '$source'\n";
+		return;
+	}
+	my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
+	return $self->__rewrite_file( $source, $dest );
+}
+
+sub __rewrite_file
+{
+	my ($self, $source, $dest) = @_;
+
+	my $mode = (stat($source))[2];
+
+	open my $sfh, "<$source" or die "Couldn't open '$source' for read";
+	print "Open input '$source' file for substitution\n";
+
+	my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
+	$self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
+	close $sfh;
+
+	seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
+
+	open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
+	print "Open output '$dest' file for substitution\n";
+
+	while( <$tmpfh> ) {
+		print $dfh $_;
+	}
+	close $dfh;
+	chmod $mode, $dest or "Couldn't change mode on '$dest'";
+}
+
+sub __process_streams
+{
+	my ($self, $in, $out, $replace) = @_;
+	
+	my @queue = ();
+	my $subst = $self->{'__subst'};
+	my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
+
+	while( my $str = <$in> ) {
+		if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
+			my ($action, $nstr) = ($1,$2);
+			$nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
+
+			die "Replace action is bad idea for situations when dest is equal to source"
+                if $replace && $action eq 'replace';
+			if( $action eq 'before' ) {
+				die "no line before 'before' action" unless @queue;
+				# overwrite prev line;
+				pop @queue;
+				push @queue, $nstr;
+				push @queue, $str;
+			} elsif( $action eq 'replace' ) {
+				push @queue, $nstr;
+			} elsif( $action eq 'after' ) {
+				push @queue, $str;
+				push @queue, $nstr;
+				# skip one line;
+				<$in>;
+			}
+		} else {
+			push @queue, $str;
+		}
+		while( @queue > 3 ) {
+			print $out shift(@queue);
+		}
+	}
+	while( scalar @queue ) {
+		print $out shift(@queue);
+	}
+}
+
+1;
+
-----------------------------------------------------------------------


hooks/post-receive
-- 
rt-extension-aws-assets