diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/ctanupload/ctanupload.pl |
Initial commit
Diffstat (limited to 'support/ctanupload/ctanupload.pl')
-rw-r--r-- | support/ctanupload/ctanupload.pl | 554 |
1 files changed, 554 insertions, 0 deletions
diff --git a/support/ctanupload/ctanupload.pl b/support/ctanupload/ctanupload.pl new file mode 100644 index 0000000000..163b490651 --- /dev/null +++ b/support/ctanupload/ctanupload.pl @@ -0,0 +1,554 @@ +#!/usr/bin/perl +################################################################################ +# Copyright (c) 2011-2012 Martin Scharrer <martin@scharrer-online.de> +# This is open source software under the GPL v3 or later. +################################################################################ +use strict; +use warnings; + +sub fromenv; +sub load_data; +sub save_data; + +my $VERSION = 'v1.2c from 2012/05/08'; +my %CTAN_SERVERURLS = ( + dante => 'http://dante.ctan.org/upload.html', + uktug => 'http://www.tex.ac.uk/upload/', +); +my %CTAN_SERVERALIASES = ( + de => 'dante', + 'uk-tug' => 'uktug', + uk => 'uktug', + cambridge => 'uktug', +); + +my $CTAN_URL; + +my @FIELDS = qw(contribution version name email summary directory DoNotAnnounce announce notes license freeversion file); +my @REQUIRED = qw(contribution version name email summary license file); +my %FIELDS = map { $_ => fromenv($_) } @FIELDS; + + +my %FIELDS_DESC = ( + contribution => 'Name of your contribution', + version => 'Version number', + name => 'Your name', + email => 'Your email', + summary => 'Summary description', + directory => 'Suggested CTAN directory', + DoNotAnnounce => 'No need to announce this update', + announce => 'Short description for announcement', + notes => 'Optional notes to the CTAN maintainers (DANTE only)', + license => 'License type', + freeversion => 'Which free license', + file => 'File to upload', +); + +my @LICENSES = qw( free nocommercial nosell nosource shareware artistic other-nonfree); + +my %LICENSES = ( + free => 'Free', + nocommercial => 'Nocommercial', + nosell => 'Nosell', + nosource => 'Nosource', + shareware => 'Shareware', + artistic => 'Perl Artistic (Clarified or later)', + 'other-nonfree' => 'Other nonfree License', +); + +my @FREEVERSIONS = qw( apache2 artistic fdl gfl gpl lgpl lppl ofl pd other-free); + +my %FREEVERSIONS = ( + apache2 => 'Apache License v2.0', + artistic => 'Perl Artistic License (version 2)', + fdl => 'GNU Free Documentation License', + gfl => 'GUST Font License', + gpl => 'GNU General Public License', + lgpl => 'Lesser GPL', + lppl => 'LaTeX Project', + ofl => 'Open Font License', + pd => 'Public Domain', + 'other-free' => 'Other Free', +); + +my $QUIET = 0; +my $ASK = 1; +my $FORCE = 0; +my $PROMPT = -t STDIN ? 1 : 0; +my $LOG = 0; + +my $LOGFILE = $ENV{CTANUPLOAD_LOGFILE}; + +sub usage { + my $warn = shift; + if ($warn) { + print STDERR "Unknown option '$warn'\n"; + } + print STDERR <<"EOT"; +ctanupload script $VERSION +Uploads a contribution to CTAN. + +Usage: +ctanupload <options> --<name>=<value> + +Arguments can also be given using the CTANUPLOAD environment variable which are processed first, so that +explicit arguments will overwrite them. + +Options: + -p Prompt for missing values. (default if run in terminal) + -P Do not prompt for missing values. (default if not run in terminal) + -y Do not ask for confirmation, but submit immediately. + -u <URL> CTAN URL to upload to (defaults to CTAN_URL environment variable or random if not set) + -U <name> CTAN server to upload to, either 'dante' or 'uktug'. + -F <file> Read data from file + -f Force upload even if input seems incorrect (unknown license etc.). + -v Verbose mode. + -q Quiet mode. + -l Write log file. + -L Do not write log file. (default) + -o <file> Define log file. (still requires -l) + -h Print this help and exit. + -V Print version number. + +The following fields exists and can be given as +--<name>=<value>, --<name> <value>, --<name>-file=<file>, --<name>-file <file> +or as environment variables: CTAN_<NAME>, CTAN_<name>, <NAME> or <name>. + +EOT + + foreach my $field (@FIELDS) { + printf STDERR " %15s %s\n", $field, $FIELDS_DESC{$field}; + } + + printf STDERR "\nValid license types:\n"; + for my $license (@LICENSES) { + printf STDERR " %15s %s\n", $license, $LICENSES{$license}; + } + + printf STDERR "\nValid free license:\n"; + for my $license (@FREEVERSIONS) { + printf STDERR " %15s %s\n", $license, $FREEVERSIONS{$license}; + } + + exit ($warn ? 1 : 0); +} + +if (exists $ENV{CTAN_URL}) { + unshift @ARGV, ('-u', $ENV{'CTAN_URL'}); +} +elsif (exists $ENV{CTAN_SERVER}) { + unshift @ARGV, ('-U', $ENV{'CTAN_SERVER'}); +} + +if (exists $ENV{'CTANUPLOAD'}) { + unshift @ARGV, (split /\s+/, $ENV{'CTANUPLOAD'}); +} + + +while (my $arg = shift @ARGV) { + if ($arg =~ /^--(.*?)(?:=(.*))?$/) { + my $name = $1; + my $value = defined $2 ? $2 : shift @ARGV; + my $file; + if ($name =~ /(.*)-file$/) { + $name = $1; + $file = $value; + } + if (exists $FIELDS{$name}) { + if ($file) { + if (open (my $valfile, '<', $file)) { + $value = join '', <$valfile>; + close ($valfile); + } + else { + warn "Couldn't read file '$file'!\n"; + $value = ''; + } + } + $FIELDS{$name} = $value; + } + else { + usage('--' . $name . ($file ? '-file' : '')); + } + } + elsif ($arg =~ /^-([a-z]+)$/i) { + for my $char (split //, $1) { + if ($char eq 'h') { + usage(0); + } + elsif ($char eq 'q') { + $QUIET = 1; + } + elsif ($char eq 'v') { + $QUIET = 0; + } + elsif ($char eq 'y') { + $ASK = 0; + } + elsif ($char eq 'F') { + my $file = shift @ARGV; + load_data ($file); + } + elsif ($char eq 'f') { + $FORCE = 1; + } + elsif ($char eq 'p') { + $PROMPT = 1; + } + elsif ($char eq 'P') { + $PROMPT = 0; + } + elsif ($char eq 'u') { + $CTAN_URL = shift @ARGV; + } + elsif ($char eq 'U') { + my $server = lc shift @ARGV; + $server = $CTAN_SERVERALIASES{$server} || $server; + if (not exists $CTAN_SERVERURLS{ $server }) { + die "Error: Unknown CTAN server '$server'.\n"; + } + $CTAN_URL = $CTAN_SERVERURLS{ $server }; + } + elsif ($char eq 'l') { + $LOG = 1; + } + elsif ($char eq 'L') { + $LOG = 0; + } + elsif ($char eq 'o') { + $LOGFILE = shift @ARGV; + } + elsif ($char eq 'V') { + print STDERR "ctanupload script $VERSION.\n"; + exit (0); + } + else { + usage('-' . $char); + } + } + } + else { + usage($arg); + } +} + +$CTAN_URL = (values %CTAN_SERVERURLS)[int rand scalar values %CTAN_SERVERURLS] + if not defined $CTAN_URL; + +my $DANTE = $CTAN_URL =~ /dante/; + +PROMPT: + +if ($PROMPT) { + foreach my $field (@FIELDS) { + if (!defined $FIELDS{$field} || !length $FIELDS{$field}) { + my $input = ''; + if ($field eq 'notes' || $field eq 'announce') { + next if $field eq 'announce' and $FIELDS{DoNotAnnounce}; + next if $field eq 'notes' and not $DANTE; + print "\u$FIELDS_DESC{$field}: (press CTRL-Z (Windows) or CTRL-D (Linux) to stop)\n"; + while (<STDIN>) { + $input .= $_; + } + } + elsif ($field eq 'DoNotAnnounce') { + print "\uNo need to announce upload? [y/N]: "; + $input = <STDIN>; + } + elsif ($field eq 'license') { + print "\u$FIELDS_DESC{$field}:\n"; + my $num = 1; + foreach my $license (@LICENSES) { + printf " [%d] %s\n", $num++, $LICENSES{$license}; + } + print "Selection: "; + $input = lc (<STDIN> || ''); + if ($input =~ /^\s*(\d+)\s*$/) { + $input = $LICENSES[$1-1]; + } + } + elsif ($field eq 'freeversion') { + next if $FIELDS{license} ne 'free'; + print "\u$FIELDS_DESC{$field}:\n"; + my $num = 1; + foreach my $license (@FREEVERSIONS) { + printf " [%d] %s\n", $num++, $FREEVERSIONS{$license}; + } + print "Selection: "; + $input = lc (<STDIN> || ''); + if ($input =~ /^\s*(\d+)\s*$/) { + $input = $FREEVERSIONS[$1-1]; + } + } + else { + print "\u$FIELDS_DESC{$field}: "; + $input = <STDIN>; + } + $input = '' if not defined $input; + chomp $input; + $input =~ s/^\s+//; + $input =~ s/\s+$//; + $FIELDS{$field} = $input; + } + } +} + +my $abort = ''; +foreach my $required (@REQUIRED) { + if (!length $FIELDS{$required}) { + $abort .= "Required field '$required' is missing!\n"; + } +} +if (not exists $LICENSES{ $FIELDS{license} }) { + $abort .= "Unknown license type '$FIELDS{license}'!\n" + if not $FORCE; +} +if ($FIELDS{license} ne 'free') { + $FIELDS{freeversion} = '-not-selected-'; +} elsif (!$FIELDS{freeversion}) { + $abort .= "Required field 'freeversion' is missing!\n"; +} elsif (not exists $FREEVERSIONS{ $FIELDS{freeversion} }) { + $abort .= "Unknown free license '$FIELDS{freeversion}'!\n" + if not $FORCE; +} +if ($FIELDS{file} && ! -f $FIELDS{file}) { + $abort .= "File '$FIELDS{file}' not found!\n"; +} + +if ($LOG) { + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); + my $DATE = sprintf ('%04d-%02d-%02d %02d:%02d:%02d', $year+1900, $mon+1, $mday, $hour, $min, $sec); + if (!$LOGFILE) { + $LOGFILE = 'ctanupload-' . $FIELDS{contribution} . " $DATE.log"; + $LOGFILE =~ tr/: /-_/; + } + save_data($LOGFILE, 1, "# $DATE"); + if (!open (LOG, '>>', $LOGFILE)) { + warn "Couldn't open logfile '$LOGFILE'.\n"; + $LOG = 0; + } +} + +if ($abort) { + print $abort, "Aborting!\n"; + if ($LOG) { + $abort =~ s/\n/\n# /gms; + print LOG "# $abort\n# Aborting!\n"; + } + exit (2); +} + +my $DoNotAnnounce = ($FIELDS{DoNotAnnounce}) ? '[x]' : '[ ]'; + +if (!$FIELDS{directory}) { + $FIELDS{directory} = '/macros/latex/contrib/' . $FIELDS{contribution}; +} + + +print "\nThe following data will be submitted to CTAN ($CTAN_URL):\n"; + +foreach my $field (@FIELDS) { + if ($field eq 'DoNotAnnounce') { + print "$FIELDS_DESC{$field}: $DoNotAnnounce\n"; + } + elsif ($field eq 'license') { + print "$FIELDS_DESC{$field}: $LICENSES{$FIELDS{$field}}\n"; + } + elsif ($field eq 'freeversion') { + print "$FIELDS_DESC{$field}: $FREEVERSIONS{$FIELDS{$field}}\n"; + } + else { + print "$FIELDS_DESC{$field}: ", $FIELDS{$field} || '', "\n"; + } +} + +eval { + my $file = $FIELDS{file}; + die if not -f $file; + print "\n$file (", (-s $file), "):\n"; + if ($file =~ /\.tar\.gz$/) { + system ('tar', 'tzvf', $file); + } +}; + +if ($ASK) { + print "\nUpload? [(y/N/(e)dit/(s)ave] "; + my $response = lc <STDIN>; + chomp ($response); + + unless ($response eq 'y' or $response eq 'yes') { + if ($response eq 'e' or $response eq 'edit') { + my $file = 'ctanupload.dat'; + save_data($file); + my $editor = $ENV{'CTANUPLOAD_EDITOR'} || $ENV{'EDITOR'}; + if (not defined $editor) { + print "No EDITOR environment variable defined.\n"; + print "Data was stored in file '$file'. Please edit manually and load with the -F option.\n"; + exit (1); + } + else { + system($editor, $file); + load_data($file); + goto PROMPT; + } + } + elsif ($response eq 's' or $response eq 'save') { + my $file = 'ctanupload.dat'; + save_data($file); + print "Data was stored in file '$file'.\n"; + print LOG "\n# Data was stored in file '$file'.\n" if $LOG; + exit (2); + } + else { + print "\nUpload aborted!\n"; + print LOG "\n# Upload aborted!\n" if $LOG; + exit (1); + } + } +} + +if ($FIELDS{DoNotAnnounce}) { + if ($DANTE) { + $FIELDS{DoNotAnnounce} = 'No'; + delete $FIELDS{'to_announce'}; + $FIELDS{notes} = ''; + } else { + $FIELDS{'to_announce'} = 'Yes'; + delete $FIELDS{DoNotAnnounce}; + delete $FIELDS{notes}; + } +} +else { + if ($DANTE) { + $FIELDS{DoNotAnnounce} = 'Yes'; + delete $FIELDS{to_announce}; + } else { + delete $FIELDS{'to_announce'}; + delete $FIELDS{DoNotAnnounce}; + delete $FIELDS{notes}; + } +} +# Add Submit button for the sake of completeness: +$FIELDS{'SUBMIT'} = ($DANTE) ? 'Submit' : 'Submit contribution'; + +use WWW::Mechanize; +my $mech = WWW::Mechanize->new(quiet => $QUIET, autocheck => 1); + +print "Accessing CTAN upload page ...\n"; +$mech->get( $CTAN_URL ); +print "Uploading ...\n"; +$mech->submit_form( + form_number => 1, + fields => \%FIELDS, +); + +if ($mech->success()) { + print "HTTP response code: ", $mech->response()->message(), "\n"; +} + +print "\nResponse:\n"; +print LOG "\n# Response:\n" if $LOG; +eval { + if ($mech->response()->header('Content-Type') eq 'text/plain') { + #open (my $DEBUGFILE, '>', 'ctanupload.dbg'); + #print {$DEBUGFILE} $mech->content(); + #close ($DEBUGFILE); + print $mech->content(); + print LOG $mech->content() if $LOG; + } + else { + use HTML::TreeBuilder; + use HTML::FormatText; + my $tree = HTML::TreeBuilder->new_from_content( $mech->content() ); + my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 80); + my @response = split /\n/, $formatter->format($tree); + local $, = "\n"; + print @response[3..$#response-3]; + local $, = "\n# "; + print LOG '', @response[3..$#response-3] if $LOG; + } + 1; +} or do { + print "Can't display HTML response, storing reponse if log file 'ctanupload_response.html'\n"; + open (HLOG, '>', 'ctanupload_response.html'); + print HLOG $mech->content(); + close (HLOG); +}; + +print "\n"; +close LOG if $LOG; +exit (0); + + +sub fromenv { + my $name = shift; + foreach my $var ('CTAN_' . uc $name, uc $name, 'CTAN_' . $name, $name) { + return $ENV{$var} if exists $ENV{$var}; + } + return undef; +} + +sub load_data { + my $file = shift; + open (my $load, '<', $file) or die "Couldn't open data file '$file'!\n"; + LOAD_LOOP: + while (my $line = <$load>) { + next if ($line =~ /^\s*(#|$)/); + if ($line =~ /^([a-z]+)\s*=\s*(.*)$/i) { + my ($name,$value) = ($1,$2); + if (!exists $FIELDS{$name}) { + print STDERR "Ignoring unknown variable '$name' from file '$file' (line $.)!\n"; + next; + } + $FIELDS{$name} = $value; + if ($name eq 'announce' || $name eq 'notes') { + $FIELDS{$name} .= "\n"; + while ($line = <$load>) { + next if ($line =~ /^\s*#/); + last if ($line =~ /^[a-z]+\s*=/i); + $FIELDS{$name} .= $line; + } + $FIELDS{$name} =~ s/^[\s\n]+//; + $FIELDS{$name} =~ s/[\s\n]+$//; + redo LOAD_LOOP if not eof $load; + } + } + else { + print STDERR "Ignoring incorrect line '$line' from file '$file' (line $.)!\n"; + } + } + close ($load); +} + +sub save_data { + my $file = shift; + my $storefileinfo = shift; + my $header = shift; + $file = 'ctanupload.dat' if not defined $file; + open (my $save, '>', $file) or do { warn "Couldn't save data to file '$file'!\n"; return; }; + print {$save} "$header\n" if $header; + foreach my $field (@FIELDS) { + if ($field eq 'DoNotAnnounce') { + print {$save} "$field = ", $FIELDS{DoNotAnnounce} ? '1' : '0', "\n"; + } + else { + print {$save} "$field = ", $FIELDS{$field} || '', "\n"; + } + } + if ($storefileinfo && -f $FIELDS{file}) { + my $file = $FIELDS{file}; + print {$save} "\n# $file (", (-s $file), "):\n"; + if ($file =~ /\.tar\.gz$/) { + open (my $TAR, '-|', "tar tzvf $file"); + print {$save} map { "# $_" } <$TAR>; + print {$save} "\n"; + close ($TAR); + } + } + close ($save); + return; +} + + + +__END__ |