#!/usr/bin/perl
################################################################################
# Copyright (c) 2011-2012 Martin Scharrer <[email protected]>
# 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__

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.