#!/usr/bin/perl ################################################################################ # Copyright (c) 2011-2012 Martin Scharrer # 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 --= 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 CTAN URL to upload to (defaults to CTAN_URL environment variable or random if not set) -U CTAN server to upload to, either 'dante' or 'uktug'. -F 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 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 --=, -- , ---file=, ---file or as environment variables: CTAN_, CTAN_, or . 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 () { $input .= $_; } } elsif ($field eq 'DoNotAnnounce') { print "\uNo need to announce upload? [y/N]: "; $input = ; } 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 ( || ''); 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 ( || ''); if ($input =~ /^\s*(\d+)\s*$/) { $input = $FREEVERSIONS[$1-1]; } } else { print "\u$FIELDS_DESC{$field}: "; $input = ; } $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 ; 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__