Changeset 2464

Timestamp:

03/03/08 15:00:42 (10 months ago)

Author:

kmaclean

Message:

WebGUI forum update scripts - adding German processing and support for German character encodings

Files:

• Trunk/Scripts/Mirroring_scripts/Single_WebGUIForum.pm (modified) (4 diffs)
• Trunk/Scripts/Mirroring_scripts/WebGUIForum.pm (modified) (14 diffs)

Trunk/Scripts/Mirroring_scripts/Single_WebGUIForum.pm

@@ -24 +24 @@
-use diagnostics;
-use Carp;
+use Archive::Extract;
+use File::Basename;
-####################################################################
-use VoxForge_config; 
@@ -37 +39 @@
-### Directory
-####################################################################
-my $AudioDirName="ruth-20080302-rhb
+#my $AudioDirName="NL-JohanLingen-20080302-das[1496202351].zip
-my $path_original ="/home/kmaclean/temp2";
+my $tarfile ="DE-anonymous-20080303-svq[186061628].zip";  # if undef than attachment does not get processed by LWP!
+my $prefix  ="DE-"; # prefix to remove from submission
+####################################################################
+print "tarfile1:$path_original/$tarfile\n";
+if ($tarfile =~ /\[.*\]/) {
+# can't get this to work with Archive::Extract??:
+        my $newDirectoryName = $tarfile;
+        $newDirectoryName =~ s/$prefix//;
+        $newDirectoryName =~ s/\[.*\]//;
+        rename("$path_original/$tarfile", "$path_original/$newDirectoryName")  || confess "error:tar file not found, cannot rename: $?";        
+        $tarfile  = $newDirectoryName;
+}
+print "tarfile2:$path_original/$tarfile\n";
+my @suffixlist = ("tgz", "tar\.gz", "zip");
+my ($AudioDirName,$path,$suffix) = fileparse($tarfile,@suffixlist);
+$AudioDirName =~ s/\.$//; # remove trailing period that fileparse does not remove for some reason??
+print "AudioDirName:$AudioDirName\n";
+
+my $ae = Archive::Extract->new( archive => "$path_original/$tarfile" );
+$ae->extract( to => "$path_original/$AudioDirName") or die $ae->error;;
-##########submission with tarfile as attachment:
-my $promptspath = "$path_original/$AudioDirName/prompts.txt";
-my $readmepath = "$path_original/$AudioDirName/readme.txt";
-my $licensepath = "$path_original/$AudioDirName/license.txt";
-
-t
+
+
-#my $readmepath = "$path_original/$AudioDirName/etc/README";
-#my $promptspath = "$path_original/$AudioDirName/etc/prompts-original";
@@ -59 +81 @@
-
-if (defined $tarfile) {
--e "$path_original/$AudioDirName.zip"
+(-e "$path_original/$tarfile") and (-e "$path_original/$AudioDirName")
-                print "path $path_original/$AudioDirName.zip\n";
-                Update($parms, \%ProcessedUserSubmissions, 'speechsubmission', 'n@wp@$$') || confess "Single_WebGUIForumUpdate error: $?";
@@ -94 +116 @@
-                        #my $licensepath = "$path_original/$AudioDirName/LICENSE";
-                        my ($content,$title)= WebGUIForum::getSubmissionContents($parms,$readmepath,$promptspath,$licensepath,$AudioDirName, $readme,$tarfile);
-$tarfile
+"$path_original/$tarfile"
-                #} else {
-                #       print "No WebGUI Forum Update - not submitted using VoxForge Speech Submission Application, or flagged for webgui forum update\n";

Trunk/Scripts/Mirroring_scripts/WebGUIForum.pm

@@ -28 +28 @@
-use Carp;
-use strict;
-# !!!!!!
-#use WWW::Curl::Easy;
-use LWP::UserAgent;
-use URI::Escape;
-#use Archive::Extract;
-
+
-####################################################################
-###  Declarations                                                          
@@ -41 +39 @@
-my $englishURL = 'http://www.voxforge.org/home/downloads/speech/english'; 
-my $dutchURL = 'http://www.voxforge.org/home/downloads/speech/dutch';
+#my $germanURL = 'http://www.voxforge.org/home/downloads/speech/german-speech-files';
-#my $englishURL = 'http://www.voxforge.org/home/downloads/speech/voxforgeivr';  # for testing 
-#my $dutchURL = 'http://www.voxforge.org/home/downloads/speech/voxforgeivr'; # for testing 
+my $germanURL = 'http://www.voxforge.org/home/downloads/speech/voxforgeivr'; # for testing 
-my $tarfile = undef; # not uploading a tarfile to WebGUI forum
-####################################################################
@@ -52 +52 @@
-        print "\nWebGUIForumUpdate.pm starting****************************************************\n\n";
-        my $counter;
-        # !!!!!!
-        # Login($parms, $username, $identifier);        
-        my $browser = LWP::UserAgent->new(keep_alive => 1 );
-        $browser->cookie_jar( {} );
-        Login($parms, $browser, $username, $identifier);        
-        # !!!!!!
-        foreach my $AudioDirName (keys %$ProcessedUserSubmissions) {
-                $counter++;
@@ -91 +88 @@
-        } elsif ($readme->getLanguage() =~ /NL/) {
-                $UploadURL =$dutchURL;
+        } elsif ($readme->getLanguage() =~ /DE/) {
+                $UploadURL =$germanURL; 
-        } else {
-                $UploadURL =$englishURL;        
@@ -98 +97 @@
-
-sub getSubmissionContents {
-        # !!!!!!
-        #my ($parms,$readmepath,$promptspath,$licensepath,$AudioDirName,$readme) = @_;
-        my ($parms,$readmepath,$promptspath,$licensepath,$AudioDirName,$readme,$tarfile) = @_;
-        # !!!!!!
-                my $debug = $$parms{"debug"};
-        my ($content);
@@ -121 +117 @@
-        #       confess ("can't extract file:$path_original/$AudioDirName")
-        #}
-
-
+
+
+
+
+
+
-        $content .= "<h2>Prompts:</h2>";
-        $content .= join(" ", @prompts);
@@ -144 +144 @@
-        #$content =~ s/&/and/g; # CURL (or WebGUI) doesn't like ampersands?? 
-        # !!!!!!
+
-        return (\$content,\$title);
-}
@@ -164 +165 @@
-
-sub Login {
-        # !!!!!!
-        #my ($parms, $username, $identifier) = @_;
-        my ($parms, $browser, $username, $identifier) = @_;
-                my $debug = $$parms{"debug"};
-        #my ($result, $err);
-        #my $post = "op=auth;method=login;username=$username;identifier=$identifier;submit=login";
-        
-        #my $curl = new WWW::Curl::Easy;
-        #$curl->setopt(CURLOPT_URL, $LoginURL);
-        #$curl->setopt(CURLOPT_COOKIEJAR, "my_cookies.txt");
-        #$curl->setopt(CURLOPT_COOKIEFILE, "my_cookies.txt");
-        #$curl->setopt(CURLOPT_CONNECTTIMEOUT, 120);
-        #$curl->setopt(CURLOPT_TIMEOUT, 10);
-        #$curl->setopt(CURLOPT_FOLLOWLOCATION,1);
-        #$curl->setopt(CURLOPT_POST, 1);
-        #$curl->setopt(CURLOPT_POSTFIELDS, $post);
-        #$curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk );
-        #$curl->setopt(CURLOPT_FILE, \$result);
-        #$curl->perform;
-        #if ($err = $curl->errbuf) {
-        #       confess ("ERROR: login failed with error: $err\n"); 
-        #}
-        #if ($result) {
-        #       ParseLoginResult($parms, \$result);
-        #} else {
-        #       confess ("ERROR: login failed, no result\n")
-        #}
-        my $result = $browser->post(
-      "$LoginURL",
@@ -215 +191 @@
-                # print  "\n\nresult:\n$result\n";
-        }
-        # !!!!!!
-}
-
@@ -221 +196 @@
-        my ($parms, $result) = @_;
-                my $debug = $$parms{"debug"};
-        # !!!!!!!               
-        #if ($$result =~ /(Hello) <a href=".+">(.+)<\/a>/i) {           
-        if ($result->content =~ /(Hello) <a href=".+">(.+)<\/a>/i) {
-                print "login status: successful\n";
-        } else {
-                #confess ("ERROR: cannot parse login result; login probably failed\nresult:$$result\n"); 
-                confess ("ERROR: cannot parse login result; login probably failed\nresult:$result->content\n"); 
-        }
-        # !!!!!!
-}
-
@@ -235 +206 @@
-        my ($parms,$browser,$content,$title,$readme,$tarfile) = @_;
-                my $debug = $$parms{"debug"};
-        #my ($result, $err, $post);
-        #       if (($tarfile ne "none") and (defined($tarfile)) and ($tarfile ne "")) {
-        #$post = "func=editSave&assetId=new&class=WebGUI::Asset::Post::Thread&proceed=showConfirmation&title=$$title&content=test&__storageId_action=upload&storageId_file=\@$tarfile&subscribe=1&submit=save";
-        
-        #my $curl = new WWW::Curl::Easy;
-        #$curl->setopt(CURLOPT_URL, $UploadURL);
-        #$curl->setopt(CURLOPT_COOKIEJAR, "my_cookies.txt");
-        #$curl->setopt(CURLOPT_COOKIEFILE, "my_cookies.txt");
-        #$curl->setopt(CURLOPT_CONNECTTIMEOUT, 120);
-        #$curl->setopt(CURLOPT_TIMEOUT, 28800);
-        #$curl->setopt(CURLOPT_FOLLOWLOCATION,1);
-        #$curl->setopt(CURLOPT_HTTPPOST, 1);
-        #$curl->setopt(CURLOPT_POSTFIELDS, $post);
-        #$curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk );
-        #$curl->setopt(CURLOPT_FILE, \$result);
-        #$curl->perform;
-        my $local_tarfile;
-        if (!defined $tarfile) {
@@ -271 +226 @@
-            'submit'      => 'save',
-          ],
-
+
+
+
-        );
-        #if ($err = $curl->errbuf) {
-        #       confess ("ERROR: login failed with error: $err"); 
-        #}
-        #if ($result) {
-        #       ParseUploadResult($parms, \$result);
-        #} else {
-        #       confess ("ERROR: Upload failed, no result\n")
-        #}
-        if ($result->is_success) {
-        ParseUploadResult($parms, $result);
@@ -293 +242 @@
-                print  "http code:" . $result->status_line. "\n";               
-        }
-
-}
-
@@ -299 +247 @@
-        my ($parms, $result) = @_;
-                my $debug = $$parms{"debug"};
-                
-        #if ($$result =~ /(Your post has been received)/i) {
-        if ($result->content =~ /(Your post has been received)/i) {
-                print "upload status: $1\n";
-        #} elsif ($$result =~ /<h1>(Permission Denied!)<\/h1>/i) {              
-        } elsif ($result->content =~ /<h1>(Permission Denied!)<\/h1>/i) {
-                #print "ERROR: $1\n\nresult:\n$$result\n";
-                confess "ERROR: $1\n\nresult:\n$result->content\n";
-        } else {
-                #confess ("ERROR: cannot parse upload result; upload probably failed\nresult:$$result\n"); 
-                confess ("ERROR: cannot parse upload result; upload probably failed\nresult:$result->content\n"); 
-        }
-}
-# !!!!!!
-#sub chunk {
-#       my ($data,$pointer)=@_; 
-#       $$pointer .= $data;
-#       return length($data);
-#}
-# !!!!!!
-1;