From 9dc9700e2d9d17be02168dcc90bd4b9a9feceb8f Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Wed, 15 Nov 2017 23:03:35 +0000 Subject: ctan-o-mat (15nov17) git-svn-id: svn://tug.org/texlive/trunk@45824 c570f23f-e606-0410-a88d-b1316a301751 --- .../source/texk/texlive/linked_scripts/Makefile.am | 1 + .../source/texk/texlive/linked_scripts/Makefile.in | 1 + .../linked_scripts/ctan-o-mat/ctan-o-mat.pl | 495 +++++++++++++++++++++ .../source/texk/texlive/linked_scripts/scripts.lst | 1 + 4 files changed, 498 insertions(+) create mode 100755 Build/source/texk/texlive/linked_scripts/ctan-o-mat/ctan-o-mat.pl (limited to 'Build/source') diff --git a/Build/source/texk/texlive/linked_scripts/Makefile.am b/Build/source/texk/texlive/linked_scripts/Makefile.am index 32804d0c3a8..535a94a2021 100644 --- a/Build/source/texk/texlive/linked_scripts/Makefile.am +++ b/Build/source/texk/texlive/linked_scripts/Makefile.am @@ -105,6 +105,7 @@ texmf_other_scripts = \ crossrefware/bibmradd.pl \ crossrefware/bibzbladd.pl \ crossrefware/ltx2crossrefxml.pl \ + ctan-o-mat/ctan-o-mat.pl \ ctanify/ctanify \ ctanupload/ctanupload.pl \ de-macro/de-macro \ diff --git a/Build/source/texk/texlive/linked_scripts/Makefile.in b/Build/source/texk/texlive/linked_scripts/Makefile.in index 5274a34bb18..f54f0939482 100644 --- a/Build/source/texk/texlive/linked_scripts/Makefile.in +++ b/Build/source/texk/texlive/linked_scripts/Makefile.in @@ -319,6 +319,7 @@ texmf_other_scripts = \ crossrefware/bibmradd.pl \ crossrefware/bibzbladd.pl \ crossrefware/ltx2crossrefxml.pl \ + ctan-o-mat/ctan-o-mat.pl \ ctanify/ctanify \ ctanupload/ctanupload.pl \ de-macro/de-macro \ diff --git a/Build/source/texk/texlive/linked_scripts/ctan-o-mat/ctan-o-mat.pl b/Build/source/texk/texlive/linked_scripts/ctan-o-mat/ctan-o-mat.pl new file mode 100755 index 00000000000..1463743432b --- /dev/null +++ b/Build/source/texk/texlive/linked_scripts/ctan-o-mat/ctan-o-mat.pl @@ -0,0 +1,495 @@ +#!/usr/bin/perl -w +##----------------------------------------------------------------------------- +## This file is part of ctan-o-mat. +## This program is distributed under BSD-like license. See file LICENSE +## +## (c) 2016-2017 Gerd Neugebauer +## +## Net: gene@gerd-neugebauer.de +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of a 3-clause BSD-like license as stated in the file +## LICENSE contained in this distribution. +## +## You should have received a copy of the LICENSE along with this program; if +## not, see the repository under https://github.com/ge-ne/ctan-o-mat. +## +##----------------------------------------------------------------------------- + +=head1 NAME + +ctan-o-mat - Upload or validate a package for CTAN + +=head1 SYNOPSIS + +ctan-o-mat [options] [] + +=head1 DESCRIPTION + +This program can be used to automate the upload of a package to CTAN +(https://www.ctan.org). The description of the package is contained in +a configuration file. Thus it can be updated easily without the need +to fill a Web form with the same old information. + +The provided information is validated in any case. If the validation +succeeds and not only the validation is requested then the provided +archive file is placed in the incoming area of the CTAN for further +processing by the CTAN team. + +In any case any finding during the validation is reported at the end +of the processing. Note that the validation is the default and a +official submission has to be requested by the an appropriate command +line option. + +B requires an Internet connection to the CTAN server. Even the +validation retrieves the known attributes and the basic constraints +from the server. + + +=head1 CONFIGURATION + +The default configuration is read from a file with the same name as +the current directory an the extension .pkg. This file name can be +overwritten on the command line. + +The configuration depends on the features supported by the CTAN server. +Since these features can change over time the configuration is not +hard-coded in B. You can request a template of the +configuration via the command line parameter C<-init>. + + +=head1 OPTIONS + +=over 4 + +=item -h + +=item --help + +Print this short summary about the usage and exit the program. + +=item --validate + +=item -n + +=item --noaction + +Do not perform the final upload. The package is validated and the +resulting messages are printed. + +=item -i + +=item --init + +Create an empty template for a configuration. + +=item -s + +=item --submit + +Upload the submission, validate it and officially submit it to CTAN it the +validation succeeds. + +=item -v + +=item --verbose + +Print some more information during the processing (verbose mode). + +=item --version + +Print the version number of this program and exit. + +=item --validate + +Print some additional debugging information. + +=item + +This parameter is the name of a package configuration +(see section CONFIGURATION) contained in a file. + +=back + +=head1 CONNECTING VIA PROXIES + +If you need to connect to the Internet via a proxy then this can be achieved +by setting some environment variables before running B. +To redirect the request via the proxy simply define an environment variable +C to point to the proxy host -- including protocol and port as +required. Note that the name of the environment variable is supposed to be in +B case. + + +=head1 AUTHOR + +Gerd Neugebauer (gene@gerd-neugebauer.de) + +=head1 BUGS + +=over 4 + +=item * + +The program can not be used without a working connection to the +Internet. + +=back + +=cut + +use strict; +use FileHandle; +use File::Basename; +use Cwd; + +use LWP::UserAgent; +use LWP::Protocol::https; +use HTTP::Request::Common; + +use constant VERSION => '1.0'; + +use constant NEW_CONFIG => 0; +use constant UPLOAD => 1; +use constant VALIDATE => 2; +use constant INCREMENT => 3; + +my $CTAN_URL = 'http://localhost:8080/submit/'; + +#------------------------------------------------------------------------------ +# Function: usage +# Arguments: none +# Returns: nothing +# Description: Print the POD to stderr and exit +# +sub usage { + use Pod::Text; + Pod::Text->new() + ->parse_from_filehandle( new FileHandle( $0, 'r' ), \*STDERR ); + exit(0); +} + +#------------------------------------------------------------------------------ +# Variable: $verbose +# Description: The verbosity indicator. +# +my $verbose = 0; + +#------------------------------------------------------------------------------ +# Variable: $method +# Description: The validation or submit indicator. +# +my $method = VALIDATE; + +#------------------------------------------------------------------------------ +# Variable: $debug +# Description: The debug indicator. +# +my $debug = 0; + +#------------------------------------------------------------------------------ +# Variable: $config +# Description: The name of the configuration file. +# +my $config = undef; + +#------------------------------------------------------------------------------ +# Variable: @fields +# Description: +# +my %fields = (); + +#------------------------------------------------------------------------------ +# Variable: @parameter +# Description: The list of fields +# +my @parameter = (); + +use Getopt::Long; +GetOptions( + "config=s" => \$config, + "pkg=s" => \$config, + "package=s" => \$config, + "debug" => \$debug, + "h|help" => \&usage, + "increment" => sub { $method = INCREMENT }, + "init" => sub { $method = NEW_CONFIG }, + "n|noaction" => sub { $method = VALIDATE; }, + "submit" => sub { $method = UPLOAD; }, + "v|verbose" => \$verbose, + "version" => sub { print STDOUT VERSION,"\n"; exit(0); }, + "validate" => sub { $method = VALIDATE; }, +); + +my $UPLOAD_URL = $CTAN_URL . 'upload'; +my $VALIDATE_URL = $CTAN_URL . 'validate'; +my $FIELDS_URL = $CTAN_URL . 'fields'; + +$config = $ARGV[0] if defined $ARGV[0]; +if ( not defined $config ) { + $config = cwd(); + $config =~ s|.*[/\\]||; + $config = $config . '.pkg'; +} + +fields(); + +if ( $method == NEW_CONFIG ) { + new_config(); +} elsif ( $method == INCREMENT ) { + increment_config(); +} else { + upload( read_config() ); +} + +#------------------------------------------------------------------------------ +# Function: upload +# Arguments: none +# Description: +# +sub upload { + my $f = shift; + + print STDERR "Uploading to CTAN..." if $verbose; + my $service_url = $UPLOAD_URL; + $service_url = $VALIDATE_URL if $method == VALIDATE; + my $ua = LWP::UserAgent->new(); + my $request = POST $service_url, + Content_Type => 'multipart/form-data', + Content => $f; + print STDERR "done\n" if $verbose; + my $response = $ua->request($request); + + die format_errors( $response->decoded_content, $response->status_line ), + "\n" + if not $response->is_success; + + if ( $method == VALIDATE and $response->decoded_content eq '[]' ) { + print "ok\n"; + } + else { + print format_errors( $response->decoded_content, 'ok' ), "\n" + } +} + +#------------------------------------------------------------------------------ +# Function: format_errors +# Arguments: +# $json the JSON list with the messages +# $fallback the fallback message if the first parameter is empty +# Description: +# +sub format_errors { + local $_ = shift; + if ( $_ eq '' ) { + return shift; + } + s/^\[*\"//g; + s/\]$//g; + my @a = map { + s/^ERROR\",\"/*** ERROR: /g; + s/^WARNING\",\"/+++ WARNING: /g; + s/^INFO\",\"/--- INFO: /g; + s/\",\"/ /g; + s/\"\]$//g; + $_ + } split /\"\],\[\"/; + return join( "\n", @a ); +} + +#------------------------------------------------------------------------------ +# Function: fields +# Arguments: none +# Description: +# +sub fields { + print STDERR "Retrieving fields from CTAN..." if $verbose; + print STDERR $FIELDS_URL if $debug; + my $response; + eval { + my $ua = LWP::UserAgent->new(); + my $request = GET $FIELDS_URL; + print STDERR "done\n" if $verbose; + $response = $ua->request($request); + }; + + die format_errors( $response->decoded_content, $response->status_line ), + "\n" + if not $response->is_success; + + local $_ = $response->decoded_content; + print STDERR $response->decoded_content, "\n\n" if $debug; + while (m/\"([a-z0-9]+)\":\{([^{}]*)\}/i) { + my $f = $1; + my %a = (); + $_ = $'; + my $attr = $2; + while ( $attr =~ m/\"([a-z0-9]+)\":([a-z0-9]+|"[^"]*")/i ) { + $attr = $'; + $a{$1} = $2; + $a{$1} =~ s/(^"|"$)//g; + } + $fields{$f} = \%a; + push @parameter, $f; + } +} + +#------------------------------------------------------------------------------ +# Function: read_config +# Arguments: +# Description: +# +sub read_config { + my %cfg = (); + my $fd = new FileHandle($config) + || die "*** Configuration file `$config' could not be read.\n"; + my $slurp = undef; + local $_; + + while (<$fd>) { + s/^[ \t]*%.*//; + s/([^\\])%.*/$1/; + while (m/\\([a-z]+)/i) { + $_ = $'; + if ( $1 eq 'begin' ) { + die "$config: missing {environment} instead of $_\n" + if not m/^[ \t]*\{([a-z]*)\}/i; + my $tag = $1; + my $val = ''; + $_ = $'; + while ( not m/\\end\{$tag\}/ ) { + $val .= $_; + $_ = <$fd>; + die "$config: unexpected end of file while searching end of $tag\n" + if not defined $_; + } + $val .= $`; + $val =~ s/^[ \t\n\r]*//m; + $val =~ s/[ \t\n\r]*$//m; + $cfg{$tag} = $val; + $_ = $'; + } + elsif ( $1 eq 'endinput' ) { + last; + } + elsif ( defined $fields{$1} ) { + my $key = $1; + die "$config: missing {environment} instead of $_\n" + if not m/^[ \t]*\{([^{}]*)\}/i; + + if ( $key eq 'file' ) { + $cfg{$key} = [$1]; + } + else { $cfg{$key} = $1; } + $_ = $'; + } + else { + die "$config: undefined keyword $&\n"; + } + s/^[ \t]*%.*//; + } + } + $fd->close(); + return \%cfg; +} + +#------------------------------------------------------------------------------ +# Function: increment_config +# Arguments: none +# Description: +# +sub increment_config { + + my $modified = undef; + my $fd = new FileHandle($config) + || die "*** Configuration file `$config' could not be read.\n"; + local $_; + my $content = ''; + + while (<$fd>) { + if (m/^[ \t]*%/) { + $content .= $_; + next; + } + if (m/\\version{([^}]*[^}0-9]*)([0-9]+)}/) { + $content .= $` . "\\version{$1" . ($2 + 1) . "}" . $'; + $modified = 1; + next; + } else { + $content .= $_; + } + } + $fd->close(); + + if ($modified) { + rename $config, $config.'.bak'; + $fd = new FileHandle($config,'w'); + print $fd $content; + $fd->close(); + } +} + +#------------------------------------------------------------------------------ +# Function: new_config +# Arguments: none +# Description: +# +sub new_config { + + print <<__EOF__; +% This is a description file for ctan-o-mat. +% It manages uploads of a package to +% CTAN -- the Comprehensive TeX Archive Network. +% +% The syntax is roughly oriented towards (La)TeX. +% Two form of the macros are used. The simple macros take one argument +% in braces. Here the argument may not contain embedded macros. +% +% The second form uses an environment enclosed in \\begin{}/\\end{}. +% In the long text fields logo macros can be used. +% +% You should enter your values between the begin and the end of the +% named type. +__EOF__ + local $_; + foreach ( @parameter ) { + print <<__EOF__; +% ------------------------------------------------------------------------- +% This field contains the $fields{$_}->{'text'}. +__EOF__ + if ( defined $fields{$_}->{'nullable'} ) { + print "% The value is optional.\n"; + } + if ( defined $fields{$_}->{'url'} ) { + print "% The value is a URL.\n"; + } + if ( defined $fields{$_}->{'email'} ) { + print "% The value is an email address.\n"; + } + if ( defined $fields{$_}->{'file'} ) { + print + "% The value is the file name of the archive to be uploaded.\n"; + print "% It may have a relative or absolute directory.\n"; + } + if ( defined $fields{$_}->{'maxsize'} ) { + print "% The value is restricted to $fields{$_}->{'maxsize'} characters.\n"; + } + if ( defined $fields{$_}->{'list'} ) { + print "% Multiple values are allowed.\n\\$_\{}\n"; + } + elsif ( defined $fields{$_}->{'maxsize'} + and $fields{$_}->{'maxsize'} ne 'null' + and $fields{$_}->{'maxsize'} < 256 ) + { + print "\\$_\{}\n"; + } + else { + print "\\begin{$_}\\end{$_}\n"; + } + } +} + +#------------------------------------------------------------------------------ +# Local Variables: +# mode: perl +# End: diff --git a/Build/source/texk/texlive/linked_scripts/scripts.lst b/Build/source/texk/texlive/linked_scripts/scripts.lst index b10451b30e8..f500c48d4c1 100644 --- a/Build/source/texk/texlive/linked_scripts/scripts.lst +++ b/Build/source/texk/texlive/linked_scripts/scripts.lst @@ -49,6 +49,7 @@ crossrefware/bibdoiadd.pl crossrefware/bibmradd.pl crossrefware/bibzbladd.pl crossrefware/ltx2crossrefxml.pl +ctan-o-mat/ctan-o-mat.pl ctanify/ctanify ctanupload/ctanupload.pl de-macro/de-macro -- cgit v1.2.3