1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#!/usr/bin/perl -w
# automated submission client for slackbuilds.org web form.
# by B. Watson <yalhcru@gmail.com>.
# Licensed under the WTFPL. See http://www.wtfpl.net/txt/copying/ for details.
# run with no arguments for usage instructions.
# requires perl/perl-LWP-Protocol-https (and all its deps including libwwwperl)
use LWP;
use Getopt::Std;
@categories = qw/
Academic
Accessibility
Audio
Business
Desktop
Development
Games
Graphics
Haskell
Libraries
Misc
Multimedia
Network
Office
Perl
Python
Ruby
System
/;
sub usage {
my $cats = join("\n", @categories);
warn <<EOF;
Usage: $0 -c <category> [-e <email>] [-C <comment>] [-k <keywords>] file
If no -e option is given, the contents of ~/.sbo_email is used as the
email address (and it's a fatal error if the file's missing).
The categories for -c are:
$cats
The -c argument is case-insensitive, and category names may be abbreviated
to the shortest unique prefix (e.g. "gr" for Graphics is OK, but "g"
is an error because it matches both Graphics and Games).
No checking is done on the file before it's uploaded (other than its
existence).
After the file is uploaded, the server's response is displayed via
"links -dump". $0's exit status does NOT reflect success/failure: it
will be zero if an upload was done, or non-zero if there's an error in
the arguments (in which case no upload is done).
EOF
exit($_[0] || 0);
}
sub die_usage {
warn $_ . "\n" for @_;
usage(1);
}
sub get_category {
my $in = shift;
my $orig = $in;
my @got;
$in =~ s/[^A-Za-z]//g;
for(@categories) {
push @got, $_ if /^$in/i;
}
if(!@got) {
die_usage("Invalid category '$orig'");
} elsif(@got > 1) {
die_usage("Ambiguous category '$orig', matches: " . join(" ", @got));
} else {
return $got[0];
}
}
if(!@ARGV || $ARGV[0] =~ /--?h(?:elp)?/i) {
usage;
}
getopts('c:e:C:k:', \%opts);
($userfile, $junk) = @ARGV;
die_usage("Unknown junk on command line: '$junk'") if $junk;
die_usage("No category (missing required -c arg)") unless $opts{c};
$category = get_category($opts{c});
$submail = $opts{e} || $ENV{SBO_EMAIL};
die_usage("No email address (use -e or else create ~/.sbostuff.cfg)") unless $submail;
$comments = $opts{C} || "";
$tags = $opts{k} || "";
if(! -e $userfile) {
die_usage("File not found: $userfile");
}
print STDERR "Uploading...";
$ua = LWP::UserAgent->new;
$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)');
$resp = $ua->post(
'https://slackbuilds.org/process_submit/',
[ MAX_FILE_SIZE => '100000',
userfile => [ $userfile ],
category => $category,
tags => $tags,
submail => $submail,
comments => $comments,
submit => 'Upload File' ],
Content_Type => 'form-data',
Referer => 'https://slackbuilds.org/submit/',
);
print STDERR "\n";
$tmpfile = "/tmp/sboul.$$." . int(rand(10 ** 10)) . ".html";
open RESULT, ">$tmpfile" or die "$tmpfile: $!";
print RESULT $resp->content;
close RESULT;
system("links -dump $tmpfile | sed -n '/Upload Results/,/Home.*Change Log/p'");
unlink $tmpfile;
warn "*** HTTP response code is " . $resp->code . "\n" unless $resp->code == 200;
|
