Websites/bugs.webkit.org/contrib/extension-convert.pl - WebKit - Git at Google

 #!/usr/bin/perl
 # This Source Code Form is subject to the terms of the Mozilla Public
 # License, v. 2.0. If a copy of the MPL was not distributed with this
 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
 #
 # This Source Code Form is "Incompatible With Secondary Licenses", as
 # defined by the Mozilla Public License, v. 2.0.

 use 5.10.1;
 use strict;
 use warnings;

 use lib qw(. lib);

 use Bugzilla;
 use Bugzilla::Constants;
 use Bugzilla::Util qw(trim);

 use File::Basename;
 use File::Copy qw(move);
 use File::Find;
 use File::Path qw(mkpath rmtree);

 my $from = $ARGV[0]
   or die <<END;
 You must specify the name of the extension you are converting from,
 as the first argument.
 END
 my $extension_name = ucfirst($from);

 my $extdir = bz_locations()->{'extensionsdir'};

 my $from_dir = "$extdir/$from";
 if (!-d $from_dir) {
     die "$from_dir does not exist.\n";
 }

 my $to_dir = "$extdir/$extension_name";
 if (-d $to_dir) {
     die "$to_dir already exists, not converting.\n";
 }

 if (ON_WINDOWS) {
     # There's no easy way to recursively copy a directory on Windows.
     print "WARNING: This will modify the contents of $from_dir.\n",
           "Press Ctrl-C to stop or any other key to continue...\n";
     getc;
     move($from_dir, $to_dir)
         || die "rename of $from_dir to $to_dir failed: $!";
 }
 else {
     print "Copying $from_dir to $to_dir...\n";
     system("cp", "-r", $from_dir, $to_dir);
 }

 # Make sure we don't accidentally modify the $from_dir anywhere else
 # in this script.
 undef $from_dir;

 if (!-d $to_dir) {
     die "$to_dir was not created.\n";
 }

 my $version = get_version($to_dir);
 move_template_hooks($to_dir);
 rename_module_packages($to_dir, $extension_name);
 my $install_requirements = get_install_requirements($to_dir);
 my ($modules, $subs) = code_files_to_subroutines($to_dir);

 my $config_pm = <<END;
 package Bugzilla::Extension::$extension_name;
 use strict;
 use warnings;

 use constant NAME => '$extension_name';
 $install_requirements
 __PACKAGE__->NAME;
 END

 my $extension_pm = <<END;
 package Bugzilla::Extension::$extension_name;
 use strict;
 use warnings;

 use parent qw(Bugzilla::Extension);

 $modules

 our \$VERSION = '$version';

 $subs

 __PACKAGE__->NAME;
 END

 open(my $config_fh, '>', "$to_dir/Config.pm") || die "$to_dir/Config.pm: $!";
 print $config_fh $config_pm;
 close($config_fh);
 open(my $extension_fh, '>', "$to_dir/Extension.pm")
   || die "$to_dir/Extension.pm: $!";
 print $extension_fh $extension_pm;
 close($extension_fh);

 rmtree("$to_dir/code");
 unlink("$to_dir/info.pl");

 ###############
 # Subroutines #
 ###############

 sub rename_module_packages {
     my ($dir, $name) = @_;
     my $lib_dir = "$dir/lib";

     # We don't want things like Bugzilla::Extension::Testopia::Testopia.
     if (-d "$lib_dir/$name") {
         print "Moving contents of $lib_dir/$name into $lib_dir...\n";
         foreach my $file (glob("$lib_dir/$name/*")) {
             my $dirname = dirname($file);
             my $basename = basename($file);
             rename($file, "$dirname/../$basename") || warn "$file: $!\n";
         }
     }

     my @modules;
     find({ wanted   => sub { $_ =~ /\.pm$/i and push(@modules, $_) },
            no_chdir => 1 }, $lib_dir);
     my %module_rename;
     foreach my $file (@modules) {
         open(my $fh, '<', $file) || die "$file: $!";
         my $content = do { local $/ = undef; <$fh> };
         close($fh);
         if ($content =~ /^package (\S+);/m) {
             my $package = $1;
             my $new_name = $file;
             $new_name =~ s/^$lib_dir\///;
             $new_name =~ s/\.pm$//;
             $new_name = join('::', File::Spec->splitdir($new_name));
             $new_name = "Bugzilla::Extension::${name}::$new_name";
             print "Renaming $package to $new_name...\n";
             $content =~ s/^package \Q$package\E;/package \Q$new_name\E;/;
             open(my $write_fh, '>', $file) || die "$file: $!";
             print $write_fh $content;
             close($write_fh);
             $module_rename{$package} = $new_name;
         }
     }

     print "Renaming module names inside of library and code files...\n";
     my @code_files = glob("$dir/code/*.pl");
     rename_modules_internally(\%module_rename, [@modules, @code_files]);
 }

 sub rename_modules_internally {
     my ($rename, $files) = @_;

     # We can't use \b because :: matches \b.
     my $break = qr/^|[^\w:]|$/;
     foreach my $file (@$files) {
         open(my $fh, '<', $file) || die "$file: $!";
         my $content = do { local $/ = undef; <$fh> };
         close($fh);
         foreach my $old_name (keys %$rename) {
             my $new_name = $rename->{$old_name};
             $content =~ s/($break)\Q$old_name\E($break)/$1$new_name$2/gms;
         }
         open(my $write_fh, '>', $file) || die "$file: $!";
         print $write_fh $content;
         close($write_fh);
     }
 }

 sub get_version {
     my ($dir) = @_;
     print "Getting version info from info.pl...\n";
     my $info;
     {
         local @INC = ("$dir/lib", @INC);
         $info = do "$dir/info.pl"; die $@ if $@;
     }
     return $info->{version};
 }

 sub get_install_requirements {
     my ($dir) = @_;
     my $file = "$dir/code/install-requirements.pl";
     return '' if !-f $file;

     print "Moving install-requirements.pl code into Config.pm...\n";
     my ($modules, $code) = process_code_file($file);
     $modules = join('', @$modules);
     $code = join('', @$code);
     if ($modules) {
         return "$modules\n\n$code";
     }
     return $code;
 }

 sub process_code_file {
     my ($file) = @_;
     open(my $fh, '<', $file) || die "$file: $!";
     my $stuff_started;
     my (@modules, @code);
     foreach my $line (<$fh>) {
         $stuff_started = 1 if $line !~ /^#/;
         next if !$stuff_started;
         next if $line =~ /^use (warnings|strict|lib|Bugzilla)[^\w:]/;
         if ($line =~ /^(?:use|require)\b/) {
             push(@modules, $line);
         }
         else {
             push(@code, $line);
         }
     }
     close $fh;
     return (\@modules, \@code);
 }

 sub code_files_to_subroutines {
     my ($dir) = @_;

     my @dir_files = glob("$dir/code/*.pl");
     my (@all_modules, @subroutines);
     foreach my $file (@dir_files) {
         next if $file =~ /install-requirements/;
         print "Moving $file code into Extension.pm...\n";
         my ($modules, $code) = process_code_file($file);
         my @code_lines = map { "    $_" } @$code;
         my $code_string = join('', @code_lines);
         $code_string =~ s/Bugzilla->hook_args/\$args/g;
         $code_string =~ s/my\s+\$args\s+=\s+\$args;//gs;
         chomp($code_string);
         push(@all_modules, @$modules);
         my $name = basename($file);
         $name =~ s/-/_/;
         $name =~ s/\.pl$//;

         my $subroutine = <<END;
 sub $name {
     my (\$self, \$args) = \@_;
 $code_string
 }
 END
         push(@subroutines, $subroutine);
     }

     my %seen_modules = map { trim($_) => 1 } @all_modules;
     my $module_string = join("\n", sort keys %seen_modules);
     my $subroutine_string = join("\n", @subroutines);
     return ($module_string, $subroutine_string);
 }

 sub move_template_hooks {
     my ($dir) = @_;
     foreach my $lang (glob("$dir/template/*")) {
         next if !_file_matters($lang);
         my $hook_container = "$lang/default/hook";
         mkpath($hook_container) || warn "$hook_container: $!";
         # Hooks can be in all sorts of weird places, including
         # template/default/hook.
         foreach my $file (glob("$lang/*")) {
             next if !_file_matters($file, 1);
             my $dirname = basename($file);
             print "Moving $file to $hook_container/$dirname...\n";
             rename($file, "$hook_container/$dirname") || die "move failed: $!";
         }
     }
 }

 sub _file_matters {
      my ($path, $tmpl) = @_;
      my @ignore = qw(default custom CVS);
      my $file = basename($path);
      return 0 if grep(lc($_) eq lc($file), @ignore);
       # Hidden files
      return 0 if $file =~ /^\./;
      if ($tmpl) {
          return 1 if $file =~ /\.tmpl$/;
      }
      return 0 if !-d $path;
      return 1;
 }

 __END__

 =head1 NAME

 extension-convert.pl - Convert extensions from the pre-3.6 format to the
 3.6 format.

 =head1 SYNOPSIS

  contrib/extension-convert.pl name

  Converts an extension in the F<extensions/> directory into the new
  extension layout for Bugzilla 3.6.
	#!/usr/bin/perl
	# This Source Code Form is subject to the terms of the Mozilla Public
	# License, v. 2.0. If a copy of the MPL was not distributed with this
	# file, You can obtain one at http://mozilla.org/MPL/2.0/.
	#
	# This Source Code Form is "Incompatible With Secondary Licenses", as
	# defined by the Mozilla Public License, v. 2.0.

	use 5.10.1;
	use strict;
	use warnings;

	use lib qw(. lib);

	use Bugzilla;
	use Bugzilla::Constants;
	use Bugzilla::Util qw(trim);

	use File::Basename;
	use File::Copy qw(move);
	use File::Find;
	use File::Path qw(mkpath rmtree);

	my $from = $ARGV[0]
	or die <<END;
	You must specify the name of the extension you are converting from,
	as the first argument.
	END
	my $extension_name = ucfirst($from);

	my $extdir = bz_locations()->{'extensionsdir'};

	my $from_dir = "$extdir/$from";
	if (!-d $from_dir) {
	die "$from_dir does not exist.\n";
	}

	my $to_dir = "$extdir/$extension_name";
	if (-d $to_dir) {
	die "$to_dir already exists, not converting.\n";
	}

	if (ON_WINDOWS) {
	# There's no easy way to recursively copy a directory on Windows.
	print "WARNING: This will modify the contents of $from_dir.\n",
	"Press Ctrl-C to stop or any other key to continue...\n";
	getc;
	move($from_dir, $to_dir)
	\|\| die "rename of $from_dir to $to_dir failed: $!";
	}
	else {
	print "Copying $from_dir to $to_dir...\n";
	system("cp", "-r", $from_dir, $to_dir);
	}

	# Make sure we don't accidentally modify the $from_dir anywhere else
	# in this script.
	undef $from_dir;

	if (!-d $to_dir) {
	die "$to_dir was not created.\n";
	}

	my $version = get_version($to_dir);
	move_template_hooks($to_dir);
	rename_module_packages($to_dir, $extension_name);
	my $install_requirements = get_install_requirements($to_dir);
	my ($modules, $subs) = code_files_to_subroutines($to_dir);

	my $config_pm = <<END;
	package Bugzilla::Extension::$extension_name;
	use strict;
	use warnings;

	use constant NAME => '$extension_name';
	$install_requirements
	__PACKAGE__->NAME;
	END

	my $extension_pm = <<END;
	package Bugzilla::Extension::$extension_name;
	use strict;
	use warnings;

	use parent qw(Bugzilla::Extension);

	$modules

	our \$VERSION = '$version';

	$subs

	__PACKAGE__->NAME;
	END

	open(my $config_fh, '>', "$to_dir/Config.pm") \|\| die "$to_dir/Config.pm: $!";
	print $config_fh $config_pm;
	close($config_fh);
	open(my $extension_fh, '>', "$to_dir/Extension.pm")
	\|\| die "$to_dir/Extension.pm: $!";
	print $extension_fh $extension_pm;
	close($extension_fh);

	rmtree("$to_dir/code");
	unlink("$to_dir/info.pl");

	###############
	# Subroutines #
	###############

	sub rename_module_packages {
	my ($dir, $name) = @_;
	my $lib_dir = "$dir/lib";

	# We don't want things like Bugzilla::Extension::Testopia::Testopia.
	if (-d "$lib_dir/$name") {
	print "Moving contents of $lib_dir/$name into $lib_dir...\n";
	foreach my $file (glob("$lib_dir/$name/*")) {
	my $dirname = dirname($file);
	my $basename = basename($file);
	rename($file, "$dirname/../$basename") \|\| warn "$file: $!\n";
	}
	}

	my @modules;
	find({ wanted => sub { $_ =~ /\.pm$/i and push(@modules, $_) },
	no_chdir => 1 }, $lib_dir);
	my %module_rename;
	foreach my $file (@modules) {
	open(my $fh, '<', $file) \|\| die "$file: $!";
	my $content = do { local $/ = undef; <$fh> };
	close($fh);
	if ($content =~ /^package (\S+);/m) {
	my $package = $1;
	my $new_name = $file;
	$new_name =~ s/^$lib_dir\///;
	$new_name =~ s/\.pm$//;
	$new_name = join('::', File::Spec->splitdir($new_name));
	$new_name = "Bugzilla::Extension::${name}::$new_name";
	print "Renaming $package to $new_name...\n";
	$content =~ s/^package \Q$package\E;/package \Q$new_name\E;/;
	open(my $write_fh, '>', $file) \|\| die "$file: $!";
	print $write_fh $content;
	close($write_fh);
	$module_rename{$package} = $new_name;
	}
	}

	print "Renaming module names inside of library and code files...\n";
	my @code_files = glob("$dir/code/*.pl");
	rename_modules_internally(\%module_rename, [@modules, @code_files]);
	}

	sub rename_modules_internally {
	my ($rename, $files) = @_;

	# We can't use \b because :: matches \b.
	my $break = qr/^\|[^\w:]\|$/;
	foreach my $file (@$files) {
	open(my $fh, '<', $file) \|\| die "$file: $!";
	my $content = do { local $/ = undef; <$fh> };
	close($fh);
	foreach my $old_name (keys %$rename) {
	my $new_name = $rename->{$old_name};
	$content =~ s/($break)\Q$old_name\E($break)/$1$new_name$2/gms;
	}
	open(my $write_fh, '>', $file) \|\| die "$file: $!";
	print $write_fh $content;
	close($write_fh);
	}
	}

	sub get_version {
	my ($dir) = @_;
	print "Getting version info from info.pl...\n";
	my $info;
	{
	local @INC = ("$dir/lib", @INC);
	$info = do "$dir/info.pl"; die $@ if $@;
	}
	return $info->{version};
	}

	sub get_install_requirements {
	my ($dir) = @_;
	my $file = "$dir/code/install-requirements.pl";
	return '' if !-f $file;

	print "Moving install-requirements.pl code into Config.pm...\n";
	my ($modules, $code) = process_code_file($file);
	$modules = join('', @$modules);
	$code = join('', @$code);
	if ($modules) {
	return "$modules\n\n$code";
	}
	return $code;
	}

	sub process_code_file {
	my ($file) = @_;
	open(my $fh, '<', $file) \|\| die "$file: $!";
	my $stuff_started;
	my (@modules, @code);
	foreach my $line (<$fh>) {
	$stuff_started = 1 if $line !~ /^#/;
	next if !$stuff_started;
	next if $line =~ /^use (warnings\|strict\|lib\|Bugzilla)[^\w:]/;
	if ($line =~ /^(?:use\|require)\b/) {
	push(@modules, $line);
	}
	else {
	push(@code, $line);
	}
	}
	close $fh;
	return (\@modules, \@code);
	}

	sub code_files_to_subroutines {
	my ($dir) = @_;

	my @dir_files = glob("$dir/code/*.pl");
	my (@all_modules, @subroutines);
	foreach my $file (@dir_files) {
	next if $file =~ /install-requirements/;
	print "Moving $file code into Extension.pm...\n";
	my ($modules, $code) = process_code_file($file);
	my @code_lines = map { " $_" } @$code;
	my $code_string = join('', @code_lines);
	$code_string =~ s/Bugzilla->hook_args/\$args/g;
	$code_string =~ s/my\s+\$args\s+=\s+\$args;//gs;
	chomp($code_string);
	push(@all_modules, @$modules);
	my $name = basename($file);
	$name =~ s/-/_/;
	$name =~ s/\.pl$//;

	my $subroutine = <<END;
	sub $name {
	my (\$self, \$args) = \@_;
	$code_string
	}
	END
	push(@subroutines, $subroutine);
	}

	my %seen_modules = map { trim($_) => 1 } @all_modules;
	my $module_string = join("\n", sort keys %seen_modules);
	my $subroutine_string = join("\n", @subroutines);
	return ($module_string, $subroutine_string);
	}

	sub move_template_hooks {
	my ($dir) = @_;
	foreach my $lang (glob("$dir/template/*")) {
	next if !_file_matters($lang);
	my $hook_container = "$lang/default/hook";
	mkpath($hook_container) \|\| warn "$hook_container: $!";
	# Hooks can be in all sorts of weird places, including
	# template/default/hook.
	foreach my $file (glob("$lang/*")) {
	next if !_file_matters($file, 1);
	my $dirname = basename($file);
	print "Moving $file to $hook_container/$dirname...\n";
	rename($file, "$hook_container/$dirname") \|\| die "move failed: $!";
	}
	}
	}

	sub _file_matters {
	my ($path, $tmpl) = @_;
	my @ignore = qw(default custom CVS);
	my $file = basename($path);
	return 0 if grep(lc($_) eq lc($file), @ignore);
	# Hidden files
	return 0 if $file =~ /^\./;
	if ($tmpl) {
	return 1 if $file =~ /\.tmpl$/;
	}
	return 0 if !-d $path;
	return 1;
	}

	__END__

	=head1 NAME

	extension-convert.pl - Convert extensions from the pre-3.6 format to the
	3.6 format.

	=head1 SYNOPSIS

	contrib/extension-convert.pl name

	Converts an extension in the F<extensions/> directory into the new
	extension layout for Bugzilla 3.6.