| 1 | #!/usr/bin/perl -w
|
|---|
| 2 | # -CDSL would be better than explicit encoding settings
|
|---|
| 3 |
|
|---|
| 4 | use strict;
|
|---|
| 5 | use utf8;
|
|---|
| 6 |
|
|---|
| 7 | my ($user, $pwd);
|
|---|
| 8 |
|
|---|
| 9 | # Three ways to handle login data:
|
|---|
| 10 | # Enter data directly in these two lines (Be careful witn svn checkin later!)
|
|---|
| 11 | # create a file "launchpad.pl_credits" containing the two lines with proper values
|
|---|
| 12 | # leave credits empty and enter them on runtime
|
|---|
| 13 | $user = '';
|
|---|
| 14 | $pwd = '';
|
|---|
| 15 |
|
|---|
| 16 | # list of supported languages
|
|---|
| 17 | my %lang = map {$_ => 1} (
|
|---|
| 18 | "bg", "ca", "cs", "da", "de", "el", "en_AU", "en_GB",
|
|---|
| 19 | "es", "et", "eu", "fi", "fr", "gl", "hu", "id",
|
|---|
| 20 | "it", "ja", "nb", "nl", "pl", "pt", "pt_BR", "ru", "sk",
|
|---|
| 21 | "sv", "tr", "uk", "zh_CN", "zh_TW"
|
|---|
| 22 | );
|
|---|
| 23 |
|
|---|
| 24 | my $revision = '$Revision: 28491 $';
|
|---|
| 25 | $revision =~ s/^.*?(\d+).*$/$1/;
|
|---|
| 26 | my $agent = "JOSM_Launchpad/1.$revision";
|
|---|
| 27 |
|
|---|
| 28 | my $count = 0;#11;
|
|---|
| 29 | my $cleanall = 0;#1;
|
|---|
| 30 | my $upload = 0;#1;
|
|---|
| 31 |
|
|---|
| 32 | if($#ARGV != 0)
|
|---|
| 33 | {
|
|---|
| 34 | warn "No argument given (try Launchpad download URL, \"bzr\", \"bzronly\", \"upload\" or \"download\").";
|
|---|
| 35 | system "ant";
|
|---|
| 36 | makeupload();
|
|---|
| 37 | }
|
|---|
| 38 | elsif($ARGV[0] eq "bzr" || $ARGV[0] eq "bzronly")
|
|---|
| 39 | {
|
|---|
| 40 | mkdir "build";
|
|---|
| 41 | die "Could not change into new data dir." if !chdir "build";
|
|---|
| 42 | system "bzr export -v josm_trans lp:~openstreetmap/josm/josm_trans";
|
|---|
| 43 | chdir "..";
|
|---|
| 44 | copypo("build/josm_trans/josm");
|
|---|
| 45 | system "rm -rv build/josm_trans";
|
|---|
| 46 | if($ARGV[0] ne "bzronly")
|
|---|
| 47 | {
|
|---|
| 48 | system "ant";
|
|---|
| 49 | makeupload();
|
|---|
| 50 | }
|
|---|
| 51 | }
|
|---|
| 52 | elsif($ARGV[0] eq "upload")
|
|---|
| 53 | {
|
|---|
| 54 | potupload();
|
|---|
| 55 | }
|
|---|
| 56 | elsif($ARGV[0] eq "download")
|
|---|
| 57 | {
|
|---|
| 58 | podownload();
|
|---|
| 59 | }
|
|---|
| 60 | elsif($ARGV[0] eq "stats")
|
|---|
| 61 | {
|
|---|
| 62 | getstats();
|
|---|
| 63 | }
|
|---|
| 64 | else
|
|---|
| 65 | {
|
|---|
| 66 | mkdir "build";
|
|---|
| 67 | mkdir "build/josm_trans";
|
|---|
| 68 | die "Could not change into new data dir." if !chdir "build/josm_trans";
|
|---|
| 69 | system "wget $ARGV[0]";
|
|---|
| 70 | system "tar -xf laun*";
|
|---|
| 71 | chdir "../..";
|
|---|
| 72 | copypo("build/josm_trans");
|
|---|
| 73 | system "rm -rv build/josm_trans";
|
|---|
| 74 | system "ant";
|
|---|
| 75 | makeupload();
|
|---|
| 76 | }
|
|---|
| 77 |
|
|---|
| 78 | sub makeupload
|
|---|
| 79 | {
|
|---|
| 80 | if($upload)
|
|---|
| 81 | {
|
|---|
| 82 | my $outdate = `date -u +"%Y-%m-%dT%H_%M_%S"`;
|
|---|
| 83 | chomp $outdate;
|
|---|
| 84 | mkdir "build/josm";
|
|---|
| 85 | system "cp po/*.po po/josm.pot build/josm";
|
|---|
| 86 | chdir "build";
|
|---|
| 87 | if(!$count)
|
|---|
| 88 | {
|
|---|
| 89 | system "tar -cjf ../launchpad_upload_josm_$outdate.tar.bz2 josm";
|
|---|
| 90 | }
|
|---|
| 91 | else
|
|---|
| 92 | {
|
|---|
| 93 | my @files = sort glob("josm/*.po");
|
|---|
| 94 | my $num = 1;
|
|---|
| 95 | while($#files >= 0)
|
|---|
| 96 | {
|
|---|
| 97 | my @f = splice(@files, 0, $count);
|
|---|
| 98 | system "tar -cjf ../launchpad_upload_josm_${outdate}_$num.tar.bz2 josm/josm.pot ".join(" ",@f);
|
|---|
| 99 | ++$num;
|
|---|
| 100 | }
|
|---|
| 101 | }
|
|---|
| 102 | system "rm -rv josm";
|
|---|
| 103 | chdir "..";
|
|---|
| 104 | }
|
|---|
| 105 | }
|
|---|
| 106 |
|
|---|
| 107 | sub copypo
|
|---|
| 108 | {
|
|---|
| 109 | my ($path) = @_;
|
|---|
| 110 | foreach my $name (split("\n", `find $path -name "*.po"`))
|
|---|
| 111 | {
|
|---|
| 112 | $name =~ /([a-zA-Z_]+)\.po/;
|
|---|
| 113 | if($lang{$1})
|
|---|
| 114 | {
|
|---|
| 115 | system "cp -v $name po/$1.po";
|
|---|
| 116 | }
|
|---|
| 117 | elsif($cleanall)
|
|---|
| 118 | {
|
|---|
| 119 | local $/; undef $/;
|
|---|
| 120 | open FILE,"<",$name or die;
|
|---|
| 121 | my $x = <FILE>;
|
|---|
| 122 | close FILE;
|
|---|
| 123 | $x =~ s/\n\n.*$/\n/s;
|
|---|
| 124 | open FILE,">","po/$1.po" or die;
|
|---|
| 125 | print FILE $x;
|
|---|
| 126 | close FILE;
|
|---|
| 127 | }
|
|---|
| 128 | }
|
|---|
| 129 | }
|
|---|
| 130 |
|
|---|
| 131 | sub dologin
|
|---|
| 132 | {
|
|---|
| 133 | require WWW::Mechanize;
|
|---|
| 134 |
|
|---|
| 135 | my $mech = WWW::Mechanize->new("agent" => $agent);
|
|---|
| 136 |
|
|---|
| 137 | #$mech->add_handler("request_send" => sub {
|
|---|
| 138 | # my($request, $ua, $h) = @_;
|
|---|
| 139 | # printf "FORM: %s\n", $request->content();
|
|---|
| 140 | # return undef;
|
|---|
| 141 | #});
|
|---|
| 142 | $mech->get("https://translations.launchpad.net/josm/trunk/+login");
|
|---|
| 143 | #print $mech->status() ." - ". $mech->uri()."\n";
|
|---|
| 144 | $mech->submit_form(form_number => 1);
|
|---|
| 145 | getcredits();
|
|---|
| 146 | #print $mech->status() ." - ". $mech->uri()."\n";
|
|---|
| 147 | $mech->submit_form(with_fields => {"email" => $user, "password" => $pwd});
|
|---|
| 148 | #$mech->dump_headers();
|
|---|
| 149 | #print $mech->status() ." - ". $mech->uri()."\n";
|
|---|
| 150 | #print $mech->content();
|
|---|
| 151 | my $form = $mech->form_name("decideform");
|
|---|
| 152 | die "Could not login.\n" if !$form;
|
|---|
| 153 | my %par = ("yes" => ""); # We need to add "yes" or it does not work
|
|---|
| 154 | foreach my $p ($form->param)
|
|---|
| 155 | {
|
|---|
| 156 | $par{$p} = $form->value($p);
|
|---|
| 157 | }
|
|---|
| 158 | $mech->post($form->action, \%par);
|
|---|
| 159 | #$mech->dump_headers();
|
|---|
| 160 | #print $mech->content();
|
|---|
| 161 | #print $mech->status() ." - ". $mech->uri()."\n";
|
|---|
| 162 | #$mech->dump_forms();
|
|---|
| 163 | return $mech;
|
|---|
| 164 | }
|
|---|
| 165 |
|
|---|
| 166 | sub potupload
|
|---|
| 167 | {
|
|---|
| 168 | my $mech = dologin();
|
|---|
| 169 | print "Starting upload.\n";
|
|---|
| 170 | sleep(2);
|
|---|
| 171 | $mech->get("https://translations.launchpad.net/josm/trunk/+translations-upload");
|
|---|
| 172 | chdir("po");
|
|---|
| 173 | $mech->submit_form(with_fields => {"file" => "josm.pot"});
|
|---|
| 174 | sleep(10);
|
|---|
| 175 | print "Trying to approve upload.\n";
|
|---|
| 176 | $mech->get("https://translations.launchpad.net/josm/trunk/+imports?field.filter_status=NEEDS_REVIEW&field.filter_extension=pot");
|
|---|
| 177 | my @links;
|
|---|
| 178 | foreach my $line (split("\n", $mech->content()))
|
|---|
| 179 | {
|
|---|
| 180 | push (@links, $1) if $line =~ /href="(\/\+imports\/\d+)"/;
|
|---|
| 181 | }
|
|---|
| 182 | if(!@links)
|
|---|
| 183 | {
|
|---|
| 184 | warn "Upload not found in import list, upload possibly failed.";
|
|---|
| 185 | }
|
|---|
| 186 | elsif(@links > 1)
|
|---|
| 187 | {
|
|---|
| 188 | warn "More than one upload found in import list, cannot approve.";
|
|---|
| 189 | }
|
|---|
| 190 | else
|
|---|
| 191 | {
|
|---|
| 192 | $mech->get("https://translations.launchpad.net$links[0]");
|
|---|
| 193 | $mech->submit_form(form_name => "launchpadform", button => "field.actions.approve");
|
|---|
| 194 | if(!($mech->content() =~ /There are no entries that match this filtering/))
|
|---|
| 195 | {
|
|---|
| 196 | warn "Approving possibly failed.";
|
|---|
| 197 | }
|
|---|
| 198 | }
|
|---|
| 199 |
|
|---|
| 200 | chdir("..");
|
|---|
| 201 | }
|
|---|
| 202 |
|
|---|
| 203 | sub podownload
|
|---|
| 204 | {
|
|---|
| 205 | my $mech = dologin();
|
|---|
| 206 | $mech->get("https://translations.launchpad.net/josm/trunk/+export");
|
|---|
| 207 | $mech->submit_form(with_fields => {"format" => "PO"});
|
|---|
| 208 | if(!($mech->content() =~ /receive an email shortly/))
|
|---|
| 209 | {
|
|---|
| 210 | warn "Error requesting file\n";
|
|---|
| 211 | }
|
|---|
| 212 | }
|
|---|
| 213 |
|
|---|
| 214 | sub getcredits
|
|---|
| 215 | {
|
|---|
| 216 | if(!$user || !$pwd)
|
|---|
| 217 | {
|
|---|
| 218 | require Term::ReadKey;
|
|---|
| 219 | local undef $/;
|
|---|
| 220 | if(open FILE, "launchpad.pl_credits")
|
|---|
| 221 | {
|
|---|
| 222 | eval <FILE>;
|
|---|
| 223 | close FILE;
|
|---|
| 224 | }
|
|---|
| 225 |
|
|---|
| 226 | if(!$user)
|
|---|
| 227 | {
|
|---|
| 228 | Term::ReadKey::ReadMode(4); # Turn off controls keys
|
|---|
| 229 | printf("Enter username: ");
|
|---|
| 230 | for(;;)
|
|---|
| 231 | {
|
|---|
| 232 | my $c = getc();
|
|---|
| 233 | print $c;
|
|---|
| 234 | last if $c eq "\n";
|
|---|
| 235 | $user .= $c;
|
|---|
| 236 | }
|
|---|
| 237 | Term::ReadKey::ReadMode(0);
|
|---|
| 238 | }
|
|---|
| 239 |
|
|---|
| 240 | if(!$pwd)
|
|---|
| 241 | {
|
|---|
| 242 | Term::ReadKey::ReadMode(4); # Turn off controls keys
|
|---|
| 243 | printf("Enter password: ");
|
|---|
| 244 | for(;;)
|
|---|
| 245 | {
|
|---|
| 246 | my $c = getc();
|
|---|
| 247 | last if $c eq "\n";
|
|---|
| 248 | print "*";
|
|---|
| 249 | $pwd .= $c;
|
|---|
| 250 | }
|
|---|
| 251 | print "\n";
|
|---|
| 252 | Term::ReadKey::ReadMode(0);
|
|---|
| 253 | }
|
|---|
| 254 | }
|
|---|
| 255 | }
|
|---|
| 256 |
|
|---|
| 257 | sub doget
|
|---|
| 258 | {
|
|---|
| 259 | my ($mech, $page, $arg) = @_;
|
|---|
| 260 | for(my $i = 1; $i <= 5; $i++)
|
|---|
| 261 | {
|
|---|
| 262 | $mech->timeout(30);
|
|---|
| 263 | eval
|
|---|
| 264 | {
|
|---|
| 265 | $mech->get($page);
|
|---|
| 266 | };
|
|---|
| 267 | my $code = $mech->status();
|
|---|
| 268 | print "Try $i: ($code) $@" if $@;
|
|---|
| 269 | return $mech if !$@;
|
|---|
| 270 | sleep(30+5*$i);
|
|---|
| 271 | last if $arg && $arg eq "no503" and $code == 503;
|
|---|
| 272 | $mech = WWW::Mechanize->new("agent" => $agent);
|
|---|
| 273 | }
|
|---|
| 274 | return $mech;
|
|---|
| 275 | }
|
|---|
| 276 |
|
|---|
| 277 | sub getstats
|
|---|
| 278 | {
|
|---|
| 279 | my %results;
|
|---|
| 280 | require WWW::Mechanize;
|
|---|
| 281 | require Data::Dumper;
|
|---|
| 282 | require URI::Escape;
|
|---|
| 283 | my $mech = WWW::Mechanize->new("agent" => $agent);
|
|---|
| 284 |
|
|---|
| 285 | if(open DFILE,"<:utf8","launchpadtrans.data")
|
|---|
| 286 | {
|
|---|
| 287 | local $/;
|
|---|
| 288 | $/ = undef;
|
|---|
| 289 | my $val = <DFILE>;
|
|---|
| 290 | eval $val;
|
|---|
| 291 | close DFILE;
|
|---|
| 292 | }
|
|---|
| 293 |
|
|---|
| 294 | binmode STDOUT, ":utf8";
|
|---|
| 295 |
|
|---|
| 296 | open FILE,">:utf8","launchpadtrans.txt" or die "Could not open output file.";
|
|---|
| 297 |
|
|---|
| 298 | for my $lang (sort keys %lang)
|
|---|
| 299 | {
|
|---|
| 300 | doget($mech, "https://translations.launchpad.net/josm/trunk/+pots/josm/$lang/");
|
|---|
| 301 | sleep(1);
|
|---|
| 302 | my $cont = $mech->content();
|
|---|
| 303 | while($cont =~ /<a href="https?:\/\/launchpad.net\/~(.*?)" class="sprite person(-inactive)?">(.*?)<\/a>/g)
|
|---|
| 304 | {
|
|---|
| 305 | my ($code, $inactive, $name) = ($1, $2, $3);
|
|---|
| 306 | if(exists($results{$code}{$lang}))
|
|---|
| 307 | {
|
|---|
| 308 | printf "%-5s - %-30s - Found - %s\n", $lang,$code,$name;
|
|---|
| 309 | next;
|
|---|
| 310 | }
|
|---|
| 311 | my $urlcode = URI::Escape::uri_escape($code);
|
|---|
| 312 | $mech = doget($mech, "https://translations.launchpad.net/josm/trunk/+pots/josm/$lang/+filter?person=$urlcode", "no503");
|
|---|
| 313 | sleep(1);
|
|---|
| 314 | my $cont = $mech->content() || "";
|
|---|
| 315 | my ($count) = $cont =~ /of[\r\n\t ]+?(\d+)[\r\n\t ]+?result/;
|
|---|
| 316 | if($count && $mech->status == 200)
|
|---|
| 317 | {
|
|---|
| 318 | $results{$code}{NAME} = $name;
|
|---|
| 319 | $results{$code}{$lang} = $count;
|
|---|
| 320 | $results{$code}{TOTAL} += $count;
|
|---|
| 321 | if(open DFILE,">:utf8","launchpadtrans.data")
|
|---|
| 322 | {
|
|---|
| 323 | print DFILE Data::Dumper->Dump([\%results],['*results']);
|
|---|
| 324 | close DFILE;
|
|---|
| 325 | }
|
|---|
| 326 | printf "%-5s - %-30s - %5d - %s\n", $lang,$code,$count,$name;
|
|---|
| 327 |
|
|---|
| 328 | }
|
|---|
| 329 | else
|
|---|
| 330 | {
|
|---|
| 331 | printf "%-5s - %-30s - Skip - %s\n", $lang,$code,$name;
|
|---|
| 332 | }
|
|---|
| 333 | }
|
|---|
| 334 | }
|
|---|
| 335 | for my $code (sort {$results{$b}{TOTAL} <=> $results{$a}{TOTAL}} keys %results)
|
|---|
| 336 | {
|
|---|
| 337 | print FILE "$results{$code}{NAME}:$results{$code}{TOTAL}";
|
|---|
| 338 | printf "%5d - %-50s",$results{$code}{TOTAL}, $results{$code}{NAME};
|
|---|
| 339 | for my $lang (sort keys %{$results{$code}})
|
|---|
| 340 | {
|
|---|
| 341 | next if $lang eq "NAME" or $lang eq "TOTAL";
|
|---|
| 342 | print FILE ";$lang=$results{$code}{$lang}";
|
|---|
| 343 | printf " - %-5s=%5d",$lang, $results{$code}{$lang};
|
|---|
| 344 | }
|
|---|
| 345 | print FILE "\n";
|
|---|
| 346 | print "\n";
|
|---|
| 347 | }
|
|---|
| 348 | }
|
|---|