texlive[45834] trunk: ctan-o-mat (16nov17)
commits+karl at tug.org
commits+karl at tug.org
Thu Nov 16 23:15:27 CET 2017
Revision: 45834
http://tug.org/svn/texlive?view=revision&revision=45834
Author: karl
Date: 2017-11-16 23:15:27 +0100 (Thu, 16 Nov 2017)
Log Message:
-----------
ctan-o-mat (16nov17)
Modified Paths:
--------------
trunk/Build/source/texk/texlive/linked_scripts/ctan-o-mat/ctan-o-mat.pl
trunk/Master/texmf-dist/doc/man/man1/ctan-o-mat.1
trunk/Master/texmf-dist/doc/man/man1/ctan-o-mat.man1.pdf
trunk/Master/texmf-dist/doc/support/ctan-o-mat/README.md
trunk/Master/texmf-dist/doc/support/ctan-o-mat/ctan-o-mat
trunk/Master/texmf-dist/doc/support/ctan-o-mat/ctan-o-mat.pkg
trunk/Master/texmf-dist/doc/support/ctan-o-mat/lib/md2ltx.pl
trunk/Master/texmf-dist/doc/support/ctan-o-mat/makefile
trunk/Master/texmf-dist/scripts/ctan-o-mat/ctan-o-mat.pl
trunk/Master/texmf-dist/source/support/ctan-o-mat/ctan-o-mat.bat
Modified: trunk/Build/source/texk/texlive/linked_scripts/ctan-o-mat/ctan-o-mat.pl
===================================================================
--- trunk/Build/source/texk/texlive/linked_scripts/ctan-o-mat/ctan-o-mat.pl 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Build/source/texk/texlive/linked_scripts/ctan-o-mat/ctan-o-mat.pl 2017-11-16 22:15:27 UTC (rev 45834)
@@ -18,7 +18,7 @@
=head1 NAME
-ctan-o-mat - Upload or validate a package for CTAN
+ctan-o-mat - Validate and upload a package for CTAN
=head1 SYNOPSIS
@@ -26,10 +26,11 @@
=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.
+This program can be used to automate the upload of a package to the
+Comprehensive TeX Archive Network (https://www.ctan.org). The description
+of the package is taken from a configuration file. Thus it can be updated
+easily without the need to fill a Web form with the same old information
+again and again.
The provided information is validated in any case. If the validation
succeeds and not only the validation is requested then the provided
@@ -52,10 +53,11 @@
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.
+The configuration depends on the features currently supported by the
+CTAN server.
Since these features can change over time the configuration is not
-hard-coded in B<ctan-o-mat>. You can request a template of the
-configuration via the command line parameter C<-init>.
+hard-coded in B<ctan-o-mat>. You can request an empty template of the
+configuration via the command line parameter C<--init>.
=head1 OPTIONS
@@ -68,20 +70,19 @@
Print this short summary about the usage and exit the program.
-=item --validate
+=item -i
-=item -n
+=item --init
-=item --noaction
+Create an empty template for a configuration.
-Do not perform the final upload. The package is validated and the
-resulting messages are printed.
+=item --config <package configuration>
-=item -i
+=item --pkg <package configuration>
-=item --init
+=item --package <package configuration>
-Create an empty template for a configuration.
+Set the package configuration file.
=item -s
@@ -102,15 +103,38 @@
=item --validate
-Print some additional debugging information.
+=item -n
+=item --noaction
+
+Do not perform the final upload. The package is validated and the
+resulting messages are printed.
+
=item <package>
This parameter is the name of a package configuration
(see section CONFIGURATION) contained in a file.
+If not set otherwise the package configuration defaults to the
+name of the current directory with C<.pkg> appended.
=back
+
+=head1 ENVIRONMENT
+
+The following environment variables are recognized by B<ctan-o-mat>.
+
+=over 4
+
+=item CTAN_O_MAT_URL
+
+The value is the URL prefix for the CTAN server to be contacted. The default
+is C<https://ctan.org/submit>. The complete URL is constructed by appending
+C<validate>, C<upload>, or C<fields> to use the respective CTAN REST API.
+
+=back
+
+
=head1 CONNECTING VIA PROXIES
If you need to connect to the Internet via a proxy then this can be achieved
@@ -143,23 +167,12 @@
use File::Basename;
use Cwd;
-use LWP::UserAgent;
-use LWP::Protocol::https;
-use HTTP::Request::Common;
+use constant VERSION => '1.1';
-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
+# Function: usage
# Arguments: none
-# Returns: nothing
+# Returns: nothing
# Description: Print the POD to stderr and exit
#
sub usage {
@@ -170,151 +183,125 @@
}
#------------------------------------------------------------------------------
-# Variable: $verbose
+# Variable: $verbose
# Description: The verbosity indicator.
#
my $verbose = 0;
#------------------------------------------------------------------------------
-# Variable: $method
-# Description: The validation or submit indicator.
-#
-my $method = VALIDATE;
-
-#------------------------------------------------------------------------------
-# Variable: $debug
+# Variable: $debug
# Description: The debug indicator.
#
my $debug = 0;
#------------------------------------------------------------------------------
-# Variable: $config
-# Description: The name of the configuration file.
+# Variable: $submit
+# Description: The validation or submit indicator.
#
-my $config = undef;
+my $submit = undef;
#------------------------------------------------------------------------------
-# Variable: @fields
-# Description:
+# Variable: $cfg
+# Description: The name of the configuration file.
#
-my %fields = ();
+my $cfg = undef;
#------------------------------------------------------------------------------
-# Variable: @parameter
-# Description: The list of fields
+# Variable: $CTAN_URL
+# Description: The base URL for requesting information from the CTAN server.
#
-my @parameter = ();
+my $CTAN_URL = $ENV{'CTAN_O_MAT_URL'} || 'https://ctan.org';
+$CTAN_URL .= '/' if not $CTAN_URL =~ m/\/$/;
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; },
+ "config=s" => \$cfg,
+ "pkg=s" => \$cfg,
+ "package=s" => \$cfg,
+ "debug" => \$debug,
+ "h|help" => \&usage,
+ "i|init:s" => sub { local $_ = pkg_name_or_fallback($_[1], '');
+ (new CTAN::Pkg())
+ ->add(pkg => $_)
+ ->write(new CTAN::Upload::Fields());
+ exit(0);
+ },
+ "n|noaction" => sub { $submit = undef; },
+ "submit|upload" => sub { $submit = 1; },
+ "v|verbose" => \$verbose,
+ "validate" => sub { $submit = undef; },
+ "version" => sub { print STDOUT VERSION, "\n"; exit(0); },
);
-my $UPLOAD_URL = $CTAN_URL . 'upload';
-my $VALIDATE_URL = $CTAN_URL . 'validate';
-my $FIELDS_URL = $CTAN_URL . 'fields';
+(new CTAN::Pkg())
+ ->read(pkg_name_or_fallback($ARGV[0] || $cfg, '.pkg'))
+ ->upload($submit);
-$config = $ARGV[0] if defined $ARGV[0];
-if ( not defined $config ) {
- $config = cwd();
- $config =~ s|.*[/\\]||;
- $config = $config . '.pkg';
+
+#------------------------------------------------------------------------------
+# Function: pkg_name_or_fallback
+# Arguments: $value the value
+# $ext the extension to append
+# Description: Construct a fallback from the current directory if $value is
+# not defined.
+#
+sub pkg_name_or_fallback {
+ my ($value, $ext) = @_;
+ if ( not defined $value or $value eq '') {
+ $value = cwd();
+ $value =~ s|.*[/\\]||;
+ $value = $value . $ext;
+ }
+ return $value;
}
-fields();
+###############################################################################
+package CTAN::Upload::Fields;
-if ( $method == NEW_CONFIG ) {
- new_config();
-} elsif ( $method == INCREMENT ) {
- increment_config();
-} else {
- upload( read_config() );
-}
+use LWP::UserAgent;
+use LWP::Protocol::https;
+use HTTP::Request::Common;
#------------------------------------------------------------------------------
-# Function: upload
-# Arguments: none
-# Description:
+# Variable: @parameter
+# Description: The list of fields.
#
-sub upload {
- my $f = shift;
+my @parameter = ();
- 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:
+# Constructor: new
+# Description: This is the constructor
#
-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 );
+sub new
+{ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $this = {};
+ bless $this,$class;
+ return $this->load();
}
#------------------------------------------------------------------------------
-# Function: fields
+# Method: load
# Arguments: none
-# Description:
+# Description: Retrieve a list of currently supported fields from the
+# CTAN server.
#
-sub fields {
- print STDERR "Retrieving fields from CTAN..." if $verbose;
- print STDERR $FIELDS_URL if $debug;
+sub load {
+ my $this = shift;
+ my $url = $CTAN_URL . 'submit/fields';
+
+ print STDERR "Retrieving fields from CTAN..." if $::verbose;
+ print STDERR $url,"\n" if $debug;
my $response;
eval {
my $ua = LWP::UserAgent->new();
- my $request = GET $FIELDS_URL;
- print STDERR "done\n" if $verbose;
+ my $request = GET $url;
+ print STDERR "done\n" if $::verbose;
$response = $ua->request($request);
};
- die format_errors( $response->decoded_content, $response->status_line ),
- "\n"
+ die CTAN::ErrorHandler::format( $response->decoded_content,
+ $response->status_line ), "\n"
if not $response->is_success;
local $_ = $response->decoded_content;
@@ -329,21 +316,88 @@
$a{$1} = $2;
$a{$1} =~ s/(^"|"$)//g;
}
- $fields{$f} = \%a;
- push @parameter, $f;
+ $this->{$f} = \%a;
+ push @CTAN::Upload::Fields::parameter, $f;
}
+ return $this;
}
+
+###############################################################################
+package CTAN::ErrorHandler;
+
#------------------------------------------------------------------------------
-# Function: read_config
+# Method: format
# Arguments:
+# $json the JSON list with the messages
+# $fallback the fallback message if the first parameter is empty
# Description:
#
-sub read_config {
- my %cfg = ();
- my $fd = new FileHandle($config)
- || die "*** Configuration file `$config' could not be read.\n";
- my $slurp = undef;
+sub format{
+ local $_ = shift;
+ if ( $_ eq '' ) {
+ return shift;
+ }
+ if (m/^(<!DOCTYPE html>|<html)/i) {
+ return "Unexpected HTML response found under $CTAN_URL";
+ }
+
+ my $json = (new JSON::Parser())->parse($_);
+ return join("\n", map { join(': ', @$_ )} @$json);
+}
+
+
+###############################################################################
+package CTAN::Pkg;
+
+use LWP::UserAgent;
+use LWP::Protocol::https;
+use HTTP::Request::Common;
+
+#------------------------------------------------------------------------------
+# Constructor: new
+# Description: This is the constructor
+#
+sub new
+{ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $this = [];
+ return bless $this,$class;
+}
+
+#------------------------------------------------------------------------------
+# Method: add
+# Arguments: arbitrary many key/value pairs
+# Description:
+# This function adds a key/value pair to the object.
+#
+sub add {
+ my $this = shift;
+ my ($key, $val);
+ $key = shift;
+ $val = shift;
+ while (defined $key and defined $val) {
+ push @$this, $key => $val;
+ $key = shift;
+ $val = shift;
+ }
+ return $this;
+}
+
+#------------------------------------------------------------------------------
+# Method: read
+# Arguments: $file the file name to be read
+# Description:
+# This function parses a configuration file in (La)TeX form and returns
+# it as hash-like list.
+#
+sub read {
+ my ($this, $file) = @_;
+ die "*** Configuration file missing.\n" if not defined $file;
+
+ my $fields = new CTAN::Upload::Fields();
+ my $fd = new FileHandle($file)
+ || die "*** Configuration file `$file' could not be read.\n";
local $_;
while (<$fd>) {
@@ -351,8 +405,9 @@
s/([^\\])%.*/$1/;
while (m/\\([a-z]+)/i) {
$_ = $';
- if ( $1 eq 'begin' ) {
- die "$config: missing {environment} instead of $_\n"
+ my $keyword = $1;
+ if ( $keyword eq 'begin' ) {
+ die "$file:$.: missing {environment} instead of $_\n"
if not m/^[ \t]*\{([a-z]*)\}/i;
my $tag = $1;
my $val = '';
@@ -360,81 +415,86 @@
while ( not m/\\end\{$tag\}/ ) {
$val .= $_;
$_ = <$fd>;
- die "$config: unexpected end of file while searching end of $tag\n"
+ die "$file:$.: "
+ . "unexpected end of file while searching end of $tag\n"
if not defined $_;
}
+ m/\\end\{$tag\}/;
+ $_ = $';
$val .= $`;
$val =~ s/^[ \t\n\r]*//m;
$val =~ s/[ \t\n\r]*$//m;
- $cfg{$tag} = $val;
- $_ = $';
+ push @$this, $tag => $val;
}
- elsif ( $1 eq 'endinput' ) {
+ elsif ( $keyword eq 'endinput' ) {
last;
}
- elsif ( defined $fields{$1} ) {
- my $key = $1;
- die "$config: missing {environment} instead of $_\n"
+ elsif ( defined $fields->{$keyword} ) {
+ die "$file:$.: missing {environment} instead of $_\n"
if not m/^[ \t]*\{([^{}]*)\}/i;
- if ( $key eq 'file' ) {
- $cfg{$key} = [$1];
- }
- else { $cfg{$key} = $1; }
+ if ( $keyword eq 'file' ) { push @$this, $keyword => [$1];
+ } else { push @$this, $keyword => $1; }
$_ = $';
}
else {
- die "$config: undefined keyword $&\n";
+ die "$file:$.: undefined keyword $keyword\n";
}
s/^[ \t]*%.*//;
}
}
$fd->close();
- return \%cfg;
+ return $this;
}
#------------------------------------------------------------------------------
-# Function: increment_config
-# Arguments: none
-# Description:
+# Method: upload
+# Arguments: ...
+# Description: Connect to the CTAN server to upload or validate the package.
#
-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 .= $_;
- }
+sub upload {
+ my $this = shift;
+ my $submit = shift;
+
+ print STDERR "Uploading to CTAN..." if $verbose;
+ my $service_url;
+ if ($submit) {
+ $service_url = $CTAN_URL . 'submit/upload';
+ } else {
+ $service_url = $CTAN_URL . 'submit/validate';
}
- $fd->close();
-
- if ($modified) {
- rename $config, $config.'.bak';
- $fd = new FileHandle($config,'w');
- print $fd $content;
- $fd->close();
+ my $ua = LWP::UserAgent->new();
+ my $request = POST ($service_url,
+ 'Content_Type' => 'multipart/form-data',
+ 'Content' => $this);
+
+ print STDERR "done\n" if $verbose;
+ my $response = $ua->request($request);
+
+ die CTAN::ErrorHandler::format($response->decoded_content,
+ $response->status_line),
+ "\n"
+ if not $response->is_success;
+
+ if ( not $submit and $response->decoded_content eq '[]' ) {
+ print "ok\n";
}
+ else {
+ print CTAN::ErrorHandler::format( $response->decoded_content, 'ok' ),
+ "\n";
+ }
+ return $this;
}
#------------------------------------------------------------------------------
-# Function: new_config
+# Method: write
# Arguments: none
-# Description:
+# Description: Write a new configuration to stdout.
#
-sub new_config {
+sub write {
+ my $this = shift;
+ my %this = @$this;
+ my $fields = shift;
print <<__EOF__;
% This is a description file for ctan-o-mat.
@@ -452,44 +512,150 @@
% named type.
__EOF__
local $_;
- foreach ( @parameter ) {
+ foreach (@CTAN::Upload::Fields::parameter) {
print <<__EOF__;
% -------------------------------------------------------------------------
-% This field contains the $fields{$_}->{'text'}.
+% This field contains the $fields->{$_}->{'text'}.
__EOF__
- if ( defined $fields{$_}->{'nullable'} ) {
+ if ( defined $fields->{$_}->{'nullable'} ) {
print "% The value is optional.\n";
}
- if ( defined $fields{$_}->{'url'} ) {
+ if ( defined $fields->{$_}->{'url'} ) {
print "% The value is a URL.\n";
}
- if ( defined $fields{$_}->{'email'} ) {
+ if ( defined $fields->{$_}->{'email'} ) {
print "% The value is an email address.\n";
}
- if ( defined $fields{$_}->{'file'} ) {
+ 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->{$_}->{'maxsize'} ) {
+ print
+"% The value is restricted to $fields->{$_}->{'maxsize'} characters.\n";
}
- if ( defined $fields{$_}->{'list'} ) {
+ 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";
+ elsif ( defined $fields->{$_}->{'maxsize'}
+ and $fields->{$_}->{'maxsize'} ne 'null'
+ and $fields->{$_}->{'maxsize'} < 256 )
+ { my $v = $this{$_};
+ $v = '' if not defined $v;
+ print "\\$_\{$v\}\n";
}
else {
- print "\\begin{$_}\\end{$_}\n";
+ my $v = $this{$_};
+ if (defined $v) {
+ $v = "\n " + $v + "\n";
+ } else {
+ $v = '';
+ }
+
+ print "\\begin{$_}$v\\end{$_}\n";
}
}
}
+###############################################################################
+
+package JSON::Parser;
#------------------------------------------------------------------------------
+# Constructor: new
+# Description: This is the constructor
+#
+sub new
+{ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $this = {};
+ return bless $this,$class;
+}
+
+#------------------------------------------------------------------------------
+# Method: parse
+# Arguments:
+# $json the JSON list with the messages
+# Description: Parse the input string for a JSON object and retrun the Perl
+# representation of it.
+#
+sub parse {
+ my ($this, $json) = @_;
+ my ( $result, $remainder ) = $this->scan($json);
+ chomp $remainder;
+ if ($remainder ne '' ) {
+ die "Unprocessed JSON: $remainder\n";
+ }
+ return $result;
+}
+
+#------------------------------------------------------------------------------
+# Method: scan
+# Arguments:
+# $json the JSON list with the messages
+# Description: Scan the input string for the next token
+#
+sub scan {
+ my ($this, $json) = @_;
+ local $_;
+ $json =~ s/^\s+//;
+ if ($json =~ m/^\[\s*/) {
+ my @a = ();
+ $json = $';
+ while ( not $json =~ m/^\]/ ) {
+ my ($el, $remainder) = $this->scan($json);
+ push @a, $el;
+ $json = $remainder;
+ if ($json =~ m/^\s*,/) {
+ $json = $';
+ }
+ }
+ $json = substr($json, 1);
+ return ( \@a, $json );
+ }
+ elsif ($json =~ m/^"/) {
+ $json = $';
+ my $s = '';
+ while ($json =~ m/(\\.|")/) {
+ $s .= $`;
+ $json = $';
+ if ( $& eq '"' ) {
+ return ($s, $json);
+ }
+ if ( $& eq '\\n' ) {
+ $s .= "\n";
+ }
+ elsif ( $& eq '\\"' ) {
+ $s .= '"';
+ }
+ elsif ( $& eq '\\t' ) {
+ $s .= "\t";
+ }
+ elsif ( $& eq '\\\\' ) {
+ $s .= "\\";
+ }
+ elsif ( $& eq '\\r' ) {
+ $s .= "\r";
+ }
+ elsif ( $& eq '\\b' ) {
+ $s .= "\b";
+ }
+ else {
+ $s .= "\\";
+ }
+ }
+ die "missing end of string\n";
+ }
+ elsif ($json =~ m/^([0-9]+|[a-z]+)/i) {
+ $json = $';
+ $_ = $&;
+ return ( $_, $json );
+ }
+
+ die "Parse error at: $json\n";
+}
+
+#------------------------------------------------------------------------------
# Local Variables:
# mode: perl
# End:
Modified: trunk/Master/texmf-dist/doc/man/man1/ctan-o-mat.1
===================================================================
--- trunk/Master/texmf-dist/doc/man/man1/ctan-o-mat.1 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Master/texmf-dist/doc/man/man1/ctan-o-mat.1 2017-11-16 22:15:27 UTC (rev 45834)
@@ -129,22 +129,23 @@
.\" ========================================================================
.\"
.IX Title "CTAN-O-MAT 1"
-.TH CTAN-O-MAT 1 "2017-10-20" "ctan-o-mat" "Gerd Neugebauer"
+.TH CTAN-O-MAT 1 "2017-11-16" "ctan-o-mat" "Gerd Neugebauer"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
.nh
.SH "NAME"
-ctan\-o\-mat \- Upload or validate a package for CTAN
+ctan\-o\-mat \- Validate and upload a package for CTAN
.SH "SYNOPSIS"
.IX Header "SYNOPSIS"
ctan-o-mat [options] [<package configuration>]
.SH "DESCRIPTION"
.IX Header "DESCRIPTION"
-This program can be used to automate the upload of a package to \s-1CTAN\s0
-(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.
+This program can be used to automate the upload of a package to the
+Comprehensive TeX Archive Network (https://www.ctan.org). The description
+of the package is taken from a configuration file. Thus it can be updated
+easily without the need to fill a Web form with the same old information
+again and again.
.PP
The provided information is validated in any case. If the validation
succeeds and not only the validation is requested then the provided
@@ -165,10 +166,11 @@
the current directory an the extension .pkg. This file name can be
overwritten on the command line.
.PP
-The configuration depends on the features supported by the \s-1CTAN\s0 server.
+The configuration depends on the features currently supported by the
+\&\s-1CTAN\s0 server.
Since these features can change over time the configuration is not
-hard-coded in \fBctan-o-mat\fR. You can request a template of the
-configuration via the command line parameter \f(CW\*(C`\-init\*(C'\fR.
+hard-coded in \fBctan-o-mat\fR. You can request an empty template of the
+configuration via the command line parameter \f(CW\*(C`\-\-init\*(C'\fR.
.SH "OPTIONS"
.IX Header "OPTIONS"
.IP "\-h" 4
@@ -178,16 +180,6 @@
.IX Item "--help"
.PD
Print this short summary about the usage and exit the program.
-.IP "\-\-validate" 4
-.IX Item "--validate"
-.PD 0
-.IP "\-n" 4
-.IX Item "-n"
-.IP "\-\-noaction" 4
-.IX Item "--noaction"
-.PD
-Do not perform the final upload. The package is validated and the
-resulting messages are printed.
.IP "\-i" 4
.IX Item "-i"
.PD 0
@@ -195,6 +187,15 @@
.IX Item "--init"
.PD
Create an empty template for a configuration.
+.IP "\-\-config <package configuration>" 4
+.IX Item "--config <package configuration>"
+.PD 0
+.IP "\-\-pkg <package configuration>" 4
+.IX Item "--pkg <package configuration>"
+.IP "\-\-package <package configuration>" 4
+.IX Item "--package <package configuration>"
+.PD
+Set the package configuration file.
.IP "\-s" 4
.IX Item "-s"
.PD 0
@@ -215,11 +216,28 @@
Print the version number of this program and exit.
.IP "\-\-validate" 4
.IX Item "--validate"
-Print some additional debugging information.
+.PD 0
+.IP "\-n" 4
+.IX Item "-n"
+.IP "\-\-noaction" 4
+.IX Item "--noaction"
+.PD
+Do not perform the final upload. The package is validated and the
+resulting messages are printed.
.IP "<package>" 4
.IX Item "<package>"
This parameter is the name of a package configuration
(see section \s-1CONFIGURATION\s0) contained in a file.
+If not set otherwise the package configuration defaults to the
+name of the current directory with \f(CW\*(C`.pkg\*(C'\fR appended.
+.SH "ENVIRONMENT"
+.IX Header "ENVIRONMENT"
+The following environment variables are recognized by \fBctan-o-mat\fR.
+.IP "\s-1CTAN_O_MAT_URL\s0" 4
+.IX Item "CTAN_O_MAT_URL"
+The value is the \s-1URL\s0 prefix for the \s-1CTAN\s0 server to be contacted. The default
+is \f(CW\*(C`https://ctan.org/submit\*(C'\fR. The complete \s-1URL\s0 is constructed by appending
+\&\f(CW\*(C`validate\*(C'\fR, \f(CW\*(C`upload\*(C'\fR, or \f(CW\*(C`fields\*(C'\fR to use the respective \s-1CTAN REST API.\s0
.SH "CONNECTING VIA PROXIES"
.IX Header "CONNECTING VIA PROXIES"
If you need to connect to the Internet via a proxy then this can be achieved
Modified: trunk/Master/texmf-dist/doc/man/man1/ctan-o-mat.man1.pdf
===================================================================
(Binary files differ)
Modified: trunk/Master/texmf-dist/doc/support/ctan-o-mat/README.md
===================================================================
--- trunk/Master/texmf-dist/doc/support/ctan-o-mat/README.md 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Master/texmf-dist/doc/support/ctan-o-mat/README.md 2017-11-16 22:15:27 UTC (rev 45834)
@@ -1,4 +1,4 @@
-# ctan-o-mat - Upload or validate a package for CTAN
+# ctan-o-mat - Validate and upload a package for CTAN
## SYNOPSIS
@@ -8,10 +8,11 @@
## 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.
+This program can be used to automate the upload of a package to the
+Comprehensive TeX Archive Network (https://www.ctan.org). The
+description of the package is taken from a configuration file. Thus it
+can be updated easily without the need to fill a Web form with the
+same old information again and again.
The provided information is validated in any case. If the validation
succeeds and not only the validation is requested then the provided
@@ -23,9 +24,9 @@
official submission has to be requested by the an appropriate command
line option.
-*ctan-o-mat* requires an Internet connection to the CTAN server. Even the
-validation retrieves the known attributes and the basic constraints
-from the server.
+*ctan-o-mat* requires an Internet connection to the CTAN server. Even
+the validation retrieves the known attributes and the basic
+constraints from the server.
## CONFIGURATION
@@ -34,10 +35,10 @@
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 *ctan-o-mat*. You can request a template of the
-configuration via the command line parameter `-init`.
+The configuration depends on the features currently supported by the CTAN
+server. Since these features can change over time the configuration is
+not hard-coded in *ctan-o-mat*. You can request an empty template of the
+configuration via the command line parameter `--init`.
## OPTIONS
@@ -49,21 +50,11 @@
Print this short summary about the usage and exit the program.
</dd>
- <dt><code>--validate</code></dt>
- <dt><code>-n</code></dt>
- <dt><code>--noaction</code></dt>
- <dd>
- Do not perform the final upload. The package is validated and the
- resulting messages are printed.
- </dd>
-
- <dt><code>-i</code></dt>
<dt><code>--init</code></dt>
<dd>
Create an empty template for a configuration.
</dd>
- <dt><code>-s</code></dt>
<dt><code>--submit</code></dt>
<dd>
Upload the submission, validate it and officially submit it to
@@ -76,30 +67,53 @@
Print some more information during the processing (verbose mode).
</dd>
- <dt><code>--version</code></dt>
+ <dt><code>--validate</code></dt>
<dd>
- Print the version number of this program and exit.
- </dd>
+ Do not perform the final upload. The package is validated and the
+ resulting messages are printed. This is the default.
+ </dd>
- <dt><code>--validate</code></dt>
+ <dt><code>--verbose</code></dt>
<dd>
Print some additional debugging information.
</dd>
- <dt><package></dt>
+ <dt><code>--version</code></dt>
<dd>
+ Print the version number of this program and exit.
+ </dd>
+
+ <dt><code><package></code></dt>
+ <dd>
This parameter is the name of a package configuration
(see section CONFIGURATION) contained in a file.
+ If not set otherwise the package configuration defaults to the
+ name of the current directory with <code>.pkg</code> appended.
</dd>
</dl>
+## ENVIRONMENT
+
+The following environment variables are recognized by B<ctan-o-mat>.
+
+<dl>
+ <dt>CTAN_O_MAT_URL</dt>
+ <dd>
+ The value is the URL prefix for the CTAN server to be contacted. The
+ default is `https://ctan.org/submit`. The complete URL is constructed
+ by appending `validate`, `upload`, or `fields` to use the respective
+ CTAN REST API.
+ </dd>
+</dl>
+
## 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 *ctan-o-mat*.
-To redirect the request via the proxy simply define an environment variable
-`http_proxy` 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 *lower* case.
+If you need to connect to the Internet via a proxy then this can be
+achieved by setting some environment variables before running
+*ctan-o-mat*. To redirect the request via the proxy simply define an
+environment variable `http_proxy` 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 *lower* case.
## INSTALLATION
@@ -106,9 +120,9 @@
### PREREQUISITE: PERL
-*ctan-o-mat* is written in Perl. Thus a Perl interpreter has to be installed,
-at least in version 5. It is assumed that the Perl interpreter is reachable
-under the name `perl` on the program path.
+*ctan-o-mat* is written in Perl. Thus a Perl interpreter has to be
+installed, at least in version 5. It is assumed that the Perl
+interpreter is reachable under the name `perl` on the program path.
### PREREQUISITE: LWP
@@ -121,15 +135,38 @@
perl -MCPAN -e 'install Bundle::LWP'
```
-You might want to check whether LWP can be installed with your package manager. In this case this is the preferred way.
+You might want to check whether LWP can be installed with your package
+manager. In this case this is the preferred way.
### INSTALLATION STEPS
-The installation is straight forward. Just put the file `ctan-o-mat.pl` and one of `ctan-o-mat` or `ctan-o-mat.bat` on your path.
+The installation is straight forward. Just put the file
+`ctan-o-mat.pl` and one of `ctan-o-mat` or `ctan-o-mat.bat` on your
+path.
-Make sure that these files are executable (if required). Now you are done.
+Make sure that these files are executable (if required). Now you are
+done.
+### CREATING THE DOCUMENTATION
+The PDF documentation is generated from the file `README.md`. This can
+be done with the following command:
+
+```
+make ctan-o-mat.pdf
+```
+
+It requires Perl and a TeX distribution to be installed and on the
+path.
+
+
+## REPOSITORY
+
+*ctan-o-mat* lives in a public repository at GitHub. It can be found under the
+URL https://github.com/ge-ne/ctan-o-mat.
+
+*ctan-o-mat* can be found on CTAN under the URL https://www.ctan.org/pkg/ctan-o-mat.
+
## AUTHOR
[Gerd Neugebauer](mailto:gene at gerd-neugebauer.de)
Modified: trunk/Master/texmf-dist/doc/support/ctan-o-mat/ctan-o-mat
===================================================================
--- trunk/Master/texmf-dist/doc/support/ctan-o-mat/ctan-o-mat 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Master/texmf-dist/doc/support/ctan-o-mat/ctan-o-mat 2017-11-16 22:15:27 UTC (rev 45834)
@@ -16,6 +16,6 @@
##
##-----------------------------------------------------------------------------
-exec perl $0.pl $*
+exec perl "$0.pl" "$@"
#
\ No newline at end of file
Modified: trunk/Master/texmf-dist/doc/support/ctan-o-mat/ctan-o-mat.pkg
===================================================================
--- trunk/Master/texmf-dist/doc/support/ctan-o-mat/ctan-o-mat.pkg 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Master/texmf-dist/doc/support/ctan-o-mat/ctan-o-mat.pkg 2017-11-16 22:15:27 UTC (rev 45834)
@@ -20,7 +20,7 @@
% This field contains the version of the package.
% The value is optional.
% The value is restricted to 32 characters.
-\version{1.0}
+\version{1.1}
% -------------------------------------------------------------------------
% This field contains the name of the author(s).
% The value is optional.
@@ -85,7 +85,7 @@
% This field contains the update indicator; true for update.
% The value is optional.
% The value is restricted to 8 characters.
-\update{false}
+\update{true}
% -------------------------------------------------------------------------
% This field contains the topics id.
% The value is optional.
@@ -100,6 +100,25 @@
This program can be used to automate the upload of a package to CTAN.
The description of the package is contained in a configuration file.
+Changes:
+
+- Handling of directories with spaces improved.
+- Error messages improved.
+- Wrong version on CTAN fixed
+\end{announcement}
+% -------------------------------------------------------------------------
+% This field contains the one-liner for the package.
+% The value is optional.
+% The value is restricted to 128 characters.
+\summary{Upload or validate a package for CTAN}
+% -------------------------------------------------------------------------
+% This field contains the descriptive abstract for the package.
+% The value is optional.
+% The value is restricted to 4096 characters.
+\begin{description}
+This program can be used to automate the upload of a package to CTAN.
+The description of the package is contained in a configuration file.
+
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
@@ -113,17 +132,15 @@
ctan-o-mat requires an Internet connection to the CTAN server. Even the
validation retrieves the known attributes and the basic constraints
from the server.
-\end{announcement}
+\end{description}
% -------------------------------------------------------------------------
-% This field contains the one-liner for the package.
-% The value is optional.
-% The value is restricted to 4096 characters.
-\begin{description}Upload or validate a package for CTAN\end{description}
-% -------------------------------------------------------------------------
% This field contains the note to the CTAN upload managers.
% The value is optional.
% The value is restricted to 2048 characters.
-\begin{note}\end{note}
+\begin{note}
+Sorry, the wrong zip has made it to CTAN.
+This gives me the chance to publish a few minor problems too.
+\end{note}
% -------------------------------------------------------------------------
% This field contains the archive file.
% The value is the file name of the archive to be uploaded.
Modified: trunk/Master/texmf-dist/doc/support/ctan-o-mat/lib/md2ltx.pl
===================================================================
--- trunk/Master/texmf-dist/doc/support/ctan-o-mat/lib/md2ltx.pl 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Master/texmf-dist/doc/support/ctan-o-mat/lib/md2ltx.pl 2017-11-16 22:15:27 UTC (rev 45834)
@@ -55,7 +55,6 @@
my $author = '';
my $title = '';
-
while(<>) {
if (m/## AUTHOR/) {
$mode = MODE_AUTHOR;
@@ -81,6 +80,10 @@
}
next
}
+ if ($mode == MODE_PRE) {
+ $body .= $_;
+ next;
+ }
$_ = "\\subsection*{".ucfirst(lc($1))."}\\label{$1}" if m/^### (.*)/;
$_ = "\\section*{".ucfirst(lc($1))."}\\label{$1}" if m/^## (.*)/;
if (m/^# (.*)/) {
@@ -98,13 +101,16 @@
s/<dl>/\\begin{description}/;
s/<\/dl>/\\end{description}/;
s/<code>(.*)<\/code>/\\texttt{$1}/;
- s/<dt>(.*)<\/dt>/\\item[$1]/;
+ s/<dt>/\\item[/;
+ s/<\/dt>/]/;
s/<dd>/\\ \\\\/;
s/ - / -- /;
- s/>/\\(>\\)/;
- s/</\\(<\\)/;
+ s/TeX /\\TeX{} /;
+ s/(>|>)/\$>\$/;
+ s/(<|<)/\$<\$/;
s/_/\\_/g;
- s|https?://[.a-z\/]*|\\url{$&}|;
+ s|https?://[.a-z\/-]*[a-z\/]|\\url{$&}|;
+ s|mailto:([\@a-z-]*)|\\href{$&}{$1}|;
$body .= $_;
}
@@ -114,14 +120,18 @@
$title = $`;
$subject = $';
}
-if ($author =~ m/\[([a-z0-9.,:; ]*)\]\(([^()]*)\)/i) {
+if ($author =~ m/\[([a-z0-9.,:; ]*)\]\(mailto:([^()]*)\)/i) {
$author = $1;
+ $author_long = "$1 (\\href{mailto:$2}{$2})";
+} elsif ($author =~ m/\[([a-z0-9.,:; ]*)\]\(([^()]*)\)/i) {
+ $author = $1;
$author_long = "$1 ($2)";
}
+
print <<__EOF__;
\\documentclass[a4paper,12pt]{scrartcl}
-\\usepackage[urlcolor=blue,urlbordercolor={.85 .85 1}]{hyperref}
+\\usepackage[colorlinks=true,urlcolor=blue]{hyperref}
\\date{}
\\hypersetup{
pdfinfo={
@@ -132,7 +142,8 @@
}
\\author{$author_long}
-\\title{$title\\thanks{This document describes \textbf{$title} version $version}\\\\$subject}
+\\title{$title\\thanks{This document describes \\textbf{$title} version $version}}
+\\subtitle{$subject}
\\begin{document}
\\maketitle
Modified: trunk/Master/texmf-dist/doc/support/ctan-o-mat/makefile
===================================================================
--- trunk/Master/texmf-dist/doc/support/ctan-o-mat/makefile 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Master/texmf-dist/doc/support/ctan-o-mat/makefile 2017-11-16 22:15:27 UTC (rev 45834)
@@ -1,6 +1,19 @@
-#******************************************************************************
-#* (c) 2017 Gerd Neugebauer
-#*=============================================================================
+##-----------------------------------------------------------------------------
+## 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 at 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.
+##
+##-----------------------------------------------------------------------------
FILES = ctan-o-mat \
ctan-o-mat.bat \
@@ -13,17 +26,20 @@
lib/md2ltx.pl
VERSION = `ctan-o-mat --version`
+LATEX = xelatex
+#------------------------------------------------------------------------------
+
all:
-clean:
+clean distclean:
$(RM) -f *~ *.out *.log *.aux ctan-o-mat.ltx
-ctan-o-mat.pdf: README.md makefile lib/md2ltx.pl
- @perl lib/md2ltx.pl --version "$(VERSION)" README.md > ctan-o-mat.ltx
- @xelatex -interaction=batchmode ctan-o-mat.ltx > /dev/null
- @xelatex -interaction=batchmode ctan-o-mat.ltx
- @$(RM) ctan-o-mat.out ctan-o-mat.aux ctan-o-mat.log
+pdf doc ctan-o-mat.pdf: README.md makefile lib/md2ltx.pl
+ @perl lib/md2ltx.pl --version "$(VERSION)" README.md > ctan-o-mat.latex
+ @$(LATEX) -interaction=batchmode ctan-o-mat.latex > /dev/null
+ @$(LATEX) -interaction=batchmode ctan-o-mat.latex
+ @$(RM) ctan-o-mat.out ctan-o-mat.aux ctan-o-mat.log ctan-o-mat.latex
dist ctan-o-mat.zip: $(FILES)
$(RM) ctan-o-mat.zip
Modified: trunk/Master/texmf-dist/scripts/ctan-o-mat/ctan-o-mat.pl
===================================================================
--- trunk/Master/texmf-dist/scripts/ctan-o-mat/ctan-o-mat.pl 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Master/texmf-dist/scripts/ctan-o-mat/ctan-o-mat.pl 2017-11-16 22:15:27 UTC (rev 45834)
@@ -18,7 +18,7 @@
=head1 NAME
-ctan-o-mat - Upload or validate a package for CTAN
+ctan-o-mat - Validate and upload a package for CTAN
=head1 SYNOPSIS
@@ -26,10 +26,11 @@
=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.
+This program can be used to automate the upload of a package to the
+Comprehensive TeX Archive Network (https://www.ctan.org). The description
+of the package is taken from a configuration file. Thus it can be updated
+easily without the need to fill a Web form with the same old information
+again and again.
The provided information is validated in any case. If the validation
succeeds and not only the validation is requested then the provided
@@ -52,10 +53,11 @@
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.
+The configuration depends on the features currently supported by the
+CTAN server.
Since these features can change over time the configuration is not
-hard-coded in B<ctan-o-mat>. You can request a template of the
-configuration via the command line parameter C<-init>.
+hard-coded in B<ctan-o-mat>. You can request an empty template of the
+configuration via the command line parameter C<--init>.
=head1 OPTIONS
@@ -68,20 +70,19 @@
Print this short summary about the usage and exit the program.
-=item --validate
+=item -i
-=item -n
+=item --init
-=item --noaction
+Create an empty template for a configuration.
-Do not perform the final upload. The package is validated and the
-resulting messages are printed.
+=item --config <package configuration>
-=item -i
+=item --pkg <package configuration>
-=item --init
+=item --package <package configuration>
-Create an empty template for a configuration.
+Set the package configuration file.
=item -s
@@ -102,15 +103,38 @@
=item --validate
-Print some additional debugging information.
+=item -n
+=item --noaction
+
+Do not perform the final upload. The package is validated and the
+resulting messages are printed.
+
=item <package>
This parameter is the name of a package configuration
(see section CONFIGURATION) contained in a file.
+If not set otherwise the package configuration defaults to the
+name of the current directory with C<.pkg> appended.
=back
+
+=head1 ENVIRONMENT
+
+The following environment variables are recognized by B<ctan-o-mat>.
+
+=over 4
+
+=item CTAN_O_MAT_URL
+
+The value is the URL prefix for the CTAN server to be contacted. The default
+is C<https://ctan.org/submit>. The complete URL is constructed by appending
+C<validate>, C<upload>, or C<fields> to use the respective CTAN REST API.
+
+=back
+
+
=head1 CONNECTING VIA PROXIES
If you need to connect to the Internet via a proxy then this can be achieved
@@ -143,23 +167,12 @@
use File::Basename;
use Cwd;
-use LWP::UserAgent;
-use LWP::Protocol::https;
-use HTTP::Request::Common;
+use constant VERSION => '1.1';
-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
+# Function: usage
# Arguments: none
-# Returns: nothing
+# Returns: nothing
# Description: Print the POD to stderr and exit
#
sub usage {
@@ -170,151 +183,125 @@
}
#------------------------------------------------------------------------------
-# Variable: $verbose
+# Variable: $verbose
# Description: The verbosity indicator.
#
my $verbose = 0;
#------------------------------------------------------------------------------
-# Variable: $method
-# Description: The validation or submit indicator.
-#
-my $method = VALIDATE;
-
-#------------------------------------------------------------------------------
-# Variable: $debug
+# Variable: $debug
# Description: The debug indicator.
#
my $debug = 0;
#------------------------------------------------------------------------------
-# Variable: $config
-# Description: The name of the configuration file.
+# Variable: $submit
+# Description: The validation or submit indicator.
#
-my $config = undef;
+my $submit = undef;
#------------------------------------------------------------------------------
-# Variable: @fields
-# Description:
+# Variable: $cfg
+# Description: The name of the configuration file.
#
-my %fields = ();
+my $cfg = undef;
#------------------------------------------------------------------------------
-# Variable: @parameter
-# Description: The list of fields
+# Variable: $CTAN_URL
+# Description: The base URL for requesting information from the CTAN server.
#
-my @parameter = ();
+my $CTAN_URL = $ENV{'CTAN_O_MAT_URL'} || 'https://ctan.org';
+$CTAN_URL .= '/' if not $CTAN_URL =~ m/\/$/;
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; },
+ "config=s" => \$cfg,
+ "pkg=s" => \$cfg,
+ "package=s" => \$cfg,
+ "debug" => \$debug,
+ "h|help" => \&usage,
+ "i|init:s" => sub { local $_ = pkg_name_or_fallback($_[1], '');
+ (new CTAN::Pkg())
+ ->add(pkg => $_)
+ ->write(new CTAN::Upload::Fields());
+ exit(0);
+ },
+ "n|noaction" => sub { $submit = undef; },
+ "submit|upload" => sub { $submit = 1; },
+ "v|verbose" => \$verbose,
+ "validate" => sub { $submit = undef; },
+ "version" => sub { print STDOUT VERSION, "\n"; exit(0); },
);
-my $UPLOAD_URL = $CTAN_URL . 'upload';
-my $VALIDATE_URL = $CTAN_URL . 'validate';
-my $FIELDS_URL = $CTAN_URL . 'fields';
+(new CTAN::Pkg())
+ ->read(pkg_name_or_fallback($ARGV[0] || $cfg, '.pkg'))
+ ->upload($submit);
-$config = $ARGV[0] if defined $ARGV[0];
-if ( not defined $config ) {
- $config = cwd();
- $config =~ s|.*[/\\]||;
- $config = $config . '.pkg';
+
+#------------------------------------------------------------------------------
+# Function: pkg_name_or_fallback
+# Arguments: $value the value
+# $ext the extension to append
+# Description: Construct a fallback from the current directory if $value is
+# not defined.
+#
+sub pkg_name_or_fallback {
+ my ($value, $ext) = @_;
+ if ( not defined $value or $value eq '') {
+ $value = cwd();
+ $value =~ s|.*[/\\]||;
+ $value = $value . $ext;
+ }
+ return $value;
}
-fields();
+###############################################################################
+package CTAN::Upload::Fields;
-if ( $method == NEW_CONFIG ) {
- new_config();
-} elsif ( $method == INCREMENT ) {
- increment_config();
-} else {
- upload( read_config() );
-}
+use LWP::UserAgent;
+use LWP::Protocol::https;
+use HTTP::Request::Common;
#------------------------------------------------------------------------------
-# Function: upload
-# Arguments: none
-# Description:
+# Variable: @parameter
+# Description: The list of fields.
#
-sub upload {
- my $f = shift;
+my @parameter = ();
- 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:
+# Constructor: new
+# Description: This is the constructor
#
-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 );
+sub new
+{ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $this = {};
+ bless $this,$class;
+ return $this->load();
}
#------------------------------------------------------------------------------
-# Function: fields
+# Method: load
# Arguments: none
-# Description:
+# Description: Retrieve a list of currently supported fields from the
+# CTAN server.
#
-sub fields {
- print STDERR "Retrieving fields from CTAN..." if $verbose;
- print STDERR $FIELDS_URL if $debug;
+sub load {
+ my $this = shift;
+ my $url = $CTAN_URL . 'submit/fields';
+
+ print STDERR "Retrieving fields from CTAN..." if $::verbose;
+ print STDERR $url,"\n" if $debug;
my $response;
eval {
my $ua = LWP::UserAgent->new();
- my $request = GET $FIELDS_URL;
- print STDERR "done\n" if $verbose;
+ my $request = GET $url;
+ print STDERR "done\n" if $::verbose;
$response = $ua->request($request);
};
- die format_errors( $response->decoded_content, $response->status_line ),
- "\n"
+ die CTAN::ErrorHandler::format( $response->decoded_content,
+ $response->status_line ), "\n"
if not $response->is_success;
local $_ = $response->decoded_content;
@@ -329,21 +316,88 @@
$a{$1} = $2;
$a{$1} =~ s/(^"|"$)//g;
}
- $fields{$f} = \%a;
- push @parameter, $f;
+ $this->{$f} = \%a;
+ push @CTAN::Upload::Fields::parameter, $f;
}
+ return $this;
}
+
+###############################################################################
+package CTAN::ErrorHandler;
+
#------------------------------------------------------------------------------
-# Function: read_config
+# Method: format
# Arguments:
+# $json the JSON list with the messages
+# $fallback the fallback message if the first parameter is empty
# Description:
#
-sub read_config {
- my %cfg = ();
- my $fd = new FileHandle($config)
- || die "*** Configuration file `$config' could not be read.\n";
- my $slurp = undef;
+sub format{
+ local $_ = shift;
+ if ( $_ eq '' ) {
+ return shift;
+ }
+ if (m/^(<!DOCTYPE html>|<html)/i) {
+ return "Unexpected HTML response found under $CTAN_URL";
+ }
+
+ my $json = (new JSON::Parser())->parse($_);
+ return join("\n", map { join(': ', @$_ )} @$json);
+}
+
+
+###############################################################################
+package CTAN::Pkg;
+
+use LWP::UserAgent;
+use LWP::Protocol::https;
+use HTTP::Request::Common;
+
+#------------------------------------------------------------------------------
+# Constructor: new
+# Description: This is the constructor
+#
+sub new
+{ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $this = [];
+ return bless $this,$class;
+}
+
+#------------------------------------------------------------------------------
+# Method: add
+# Arguments: arbitrary many key/value pairs
+# Description:
+# This function adds a key/value pair to the object.
+#
+sub add {
+ my $this = shift;
+ my ($key, $val);
+ $key = shift;
+ $val = shift;
+ while (defined $key and defined $val) {
+ push @$this, $key => $val;
+ $key = shift;
+ $val = shift;
+ }
+ return $this;
+}
+
+#------------------------------------------------------------------------------
+# Method: read
+# Arguments: $file the file name to be read
+# Description:
+# This function parses a configuration file in (La)TeX form and returns
+# it as hash-like list.
+#
+sub read {
+ my ($this, $file) = @_;
+ die "*** Configuration file missing.\n" if not defined $file;
+
+ my $fields = new CTAN::Upload::Fields();
+ my $fd = new FileHandle($file)
+ || die "*** Configuration file `$file' could not be read.\n";
local $_;
while (<$fd>) {
@@ -351,8 +405,9 @@
s/([^\\])%.*/$1/;
while (m/\\([a-z]+)/i) {
$_ = $';
- if ( $1 eq 'begin' ) {
- die "$config: missing {environment} instead of $_\n"
+ my $keyword = $1;
+ if ( $keyword eq 'begin' ) {
+ die "$file:$.: missing {environment} instead of $_\n"
if not m/^[ \t]*\{([a-z]*)\}/i;
my $tag = $1;
my $val = '';
@@ -360,81 +415,86 @@
while ( not m/\\end\{$tag\}/ ) {
$val .= $_;
$_ = <$fd>;
- die "$config: unexpected end of file while searching end of $tag\n"
+ die "$file:$.: "
+ . "unexpected end of file while searching end of $tag\n"
if not defined $_;
}
+ m/\\end\{$tag\}/;
+ $_ = $';
$val .= $`;
$val =~ s/^[ \t\n\r]*//m;
$val =~ s/[ \t\n\r]*$//m;
- $cfg{$tag} = $val;
- $_ = $';
+ push @$this, $tag => $val;
}
- elsif ( $1 eq 'endinput' ) {
+ elsif ( $keyword eq 'endinput' ) {
last;
}
- elsif ( defined $fields{$1} ) {
- my $key = $1;
- die "$config: missing {environment} instead of $_\n"
+ elsif ( defined $fields->{$keyword} ) {
+ die "$file:$.: missing {environment} instead of $_\n"
if not m/^[ \t]*\{([^{}]*)\}/i;
- if ( $key eq 'file' ) {
- $cfg{$key} = [$1];
- }
- else { $cfg{$key} = $1; }
+ if ( $keyword eq 'file' ) { push @$this, $keyword => [$1];
+ } else { push @$this, $keyword => $1; }
$_ = $';
}
else {
- die "$config: undefined keyword $&\n";
+ die "$file:$.: undefined keyword $keyword\n";
}
s/^[ \t]*%.*//;
}
}
$fd->close();
- return \%cfg;
+ return $this;
}
#------------------------------------------------------------------------------
-# Function: increment_config
-# Arguments: none
-# Description:
+# Method: upload
+# Arguments: ...
+# Description: Connect to the CTAN server to upload or validate the package.
#
-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 .= $_;
- }
+sub upload {
+ my $this = shift;
+ my $submit = shift;
+
+ print STDERR "Uploading to CTAN..." if $verbose;
+ my $service_url;
+ if ($submit) {
+ $service_url = $CTAN_URL . 'submit/upload';
+ } else {
+ $service_url = $CTAN_URL . 'submit/validate';
}
- $fd->close();
-
- if ($modified) {
- rename $config, $config.'.bak';
- $fd = new FileHandle($config,'w');
- print $fd $content;
- $fd->close();
+ my $ua = LWP::UserAgent->new();
+ my $request = POST ($service_url,
+ 'Content_Type' => 'multipart/form-data',
+ 'Content' => $this);
+
+ print STDERR "done\n" if $verbose;
+ my $response = $ua->request($request);
+
+ die CTAN::ErrorHandler::format($response->decoded_content,
+ $response->status_line),
+ "\n"
+ if not $response->is_success;
+
+ if ( not $submit and $response->decoded_content eq '[]' ) {
+ print "ok\n";
}
+ else {
+ print CTAN::ErrorHandler::format( $response->decoded_content, 'ok' ),
+ "\n";
+ }
+ return $this;
}
#------------------------------------------------------------------------------
-# Function: new_config
+# Method: write
# Arguments: none
-# Description:
+# Description: Write a new configuration to stdout.
#
-sub new_config {
+sub write {
+ my $this = shift;
+ my %this = @$this;
+ my $fields = shift;
print <<__EOF__;
% This is a description file for ctan-o-mat.
@@ -452,44 +512,150 @@
% named type.
__EOF__
local $_;
- foreach ( @parameter ) {
+ foreach (@CTAN::Upload::Fields::parameter) {
print <<__EOF__;
% -------------------------------------------------------------------------
-% This field contains the $fields{$_}->{'text'}.
+% This field contains the $fields->{$_}->{'text'}.
__EOF__
- if ( defined $fields{$_}->{'nullable'} ) {
+ if ( defined $fields->{$_}->{'nullable'} ) {
print "% The value is optional.\n";
}
- if ( defined $fields{$_}->{'url'} ) {
+ if ( defined $fields->{$_}->{'url'} ) {
print "% The value is a URL.\n";
}
- if ( defined $fields{$_}->{'email'} ) {
+ if ( defined $fields->{$_}->{'email'} ) {
print "% The value is an email address.\n";
}
- if ( defined $fields{$_}->{'file'} ) {
+ 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->{$_}->{'maxsize'} ) {
+ print
+"% The value is restricted to $fields->{$_}->{'maxsize'} characters.\n";
}
- if ( defined $fields{$_}->{'list'} ) {
+ 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";
+ elsif ( defined $fields->{$_}->{'maxsize'}
+ and $fields->{$_}->{'maxsize'} ne 'null'
+ and $fields->{$_}->{'maxsize'} < 256 )
+ { my $v = $this{$_};
+ $v = '' if not defined $v;
+ print "\\$_\{$v\}\n";
}
else {
- print "\\begin{$_}\\end{$_}\n";
+ my $v = $this{$_};
+ if (defined $v) {
+ $v = "\n " + $v + "\n";
+ } else {
+ $v = '';
+ }
+
+ print "\\begin{$_}$v\\end{$_}\n";
}
}
}
+###############################################################################
+
+package JSON::Parser;
#------------------------------------------------------------------------------
+# Constructor: new
+# Description: This is the constructor
+#
+sub new
+{ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $this = {};
+ return bless $this,$class;
+}
+
+#------------------------------------------------------------------------------
+# Method: parse
+# Arguments:
+# $json the JSON list with the messages
+# Description: Parse the input string for a JSON object and retrun the Perl
+# representation of it.
+#
+sub parse {
+ my ($this, $json) = @_;
+ my ( $result, $remainder ) = $this->scan($json);
+ chomp $remainder;
+ if ($remainder ne '' ) {
+ die "Unprocessed JSON: $remainder\n";
+ }
+ return $result;
+}
+
+#------------------------------------------------------------------------------
+# Method: scan
+# Arguments:
+# $json the JSON list with the messages
+# Description: Scan the input string for the next token
+#
+sub scan {
+ my ($this, $json) = @_;
+ local $_;
+ $json =~ s/^\s+//;
+ if ($json =~ m/^\[\s*/) {
+ my @a = ();
+ $json = $';
+ while ( not $json =~ m/^\]/ ) {
+ my ($el, $remainder) = $this->scan($json);
+ push @a, $el;
+ $json = $remainder;
+ if ($json =~ m/^\s*,/) {
+ $json = $';
+ }
+ }
+ $json = substr($json, 1);
+ return ( \@a, $json );
+ }
+ elsif ($json =~ m/^"/) {
+ $json = $';
+ my $s = '';
+ while ($json =~ m/(\\.|")/) {
+ $s .= $`;
+ $json = $';
+ if ( $& eq '"' ) {
+ return ($s, $json);
+ }
+ if ( $& eq '\\n' ) {
+ $s .= "\n";
+ }
+ elsif ( $& eq '\\"' ) {
+ $s .= '"';
+ }
+ elsif ( $& eq '\\t' ) {
+ $s .= "\t";
+ }
+ elsif ( $& eq '\\\\' ) {
+ $s .= "\\";
+ }
+ elsif ( $& eq '\\r' ) {
+ $s .= "\r";
+ }
+ elsif ( $& eq '\\b' ) {
+ $s .= "\b";
+ }
+ else {
+ $s .= "\\";
+ }
+ }
+ die "missing end of string\n";
+ }
+ elsif ($json =~ m/^([0-9]+|[a-z]+)/i) {
+ $json = $';
+ $_ = $&;
+ return ( $_, $json );
+ }
+
+ die "Parse error at: $json\n";
+}
+
+#------------------------------------------------------------------------------
# Local Variables:
# mode: perl
# End:
Modified: trunk/Master/texmf-dist/source/support/ctan-o-mat/ctan-o-mat.bat
===================================================================
--- trunk/Master/texmf-dist/source/support/ctan-o-mat/ctan-o-mat.bat 2017-11-16 22:15:04 UTC (rev 45833)
+++ trunk/Master/texmf-dist/source/support/ctan-o-mat/ctan-o-mat.bat 2017-11-16 22:15:27 UTC (rev 45834)
@@ -1,21 +1,21 @@
- at echo off
- at rem --------------------------------------------------------------------------
- at rem This file is part of ctan-o-mat.
- at rem This program is distributed under BSD-like license. See file LICENSE
- at rem
- at rem (c) 2016-2017 Gerd Neugebauer
- at rem
- at rem Net: gene at gerd-neugebauer.de
- at rem
- at rem This program is free software; you can redistribute it and/or modify
- at rem it under the terms of a 3-clause BSD-like license as stated in the
- at rem file LICENSE contained in this distribution.
- at rem
- at rem You should have received a copy of the LICENSE along with this
- at rem program; if not, see the repository under http://***.
- at rem
- at rem --------------------------------------------------------------------------
-
-"perl ctan-o-mat.pl %*"
-
- at rem --------------------------------------------------------------------------
+ at echo off
+ at rem --------------------------------------------------------------------------
+ at rem This file is part of ctan-o-mat.
+ at rem This program is distributed under BSD-like license. See file LICENSE
+ at rem
+ at rem (c) 2016-2017 Gerd Neugebauer
+ at rem
+ at rem Net: gene at gerd-neugebauer.de
+ at rem
+ at rem This program is free software; you can redistribute it and/or modify
+ at rem it under the terms of a 3-clause BSD-like license as stated in the
+ at rem file LICENSE contained in this distribution.
+ at rem
+ at rem You should have received a copy of the LICENSE along with this
+ at rem program; if not, see the repository under http://***.
+ at rem
+ at rem --------------------------------------------------------------------------
+
+"perl ctan-o-mat.pl %*"
+
+ at rem --------------------------------------------------------------------------
More information about the tex-live-commits
mailing list