voxforge.org
VoxForge Dev
Home · Read · Listen · Forums · Dev · Downloads · About

Changeset 2386

Show
Ignore:
Timestamp:
01/06/08 22:29:29 (1 year ago)
Author:
kmaclean
Message:

submission of SpeechSubmission zip file to WebGUI Forum - snapshot

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • Trunk/Scripts/Mirroring_scripts/WebGUIForumUpdate.pm

    r2385 r2386  
    22#################################################################### 
    33### 
    4 ### script name : WebGUIForumUpdate.pl 
     4### script name : WebGUIForumUpdate.pm 
    55### version: 0.1 
    66### created by: Ken MacLean 
    77### mail: contact@voxforge.org 
    88### Date: 2007.1.05 
    9 ### Command: perl ./WebGUIForumUpdate.pl 
     9### Command: perl ./WebGUIForumUpdate.pm ($parms, $ProcessedUserSubmissions) 
    1010###     
    1111### Copyright (C) 2007 Ken MacLean 
    …… 
    3131###  Declarations                                                           
    3232#################################################################### 
    33 my $url ='http://www.scout.org/home/downloads/audio/model-repository/audio-speech-files'; 
     33my $LoginURL ='http://www.scout.org'; 
     34my $UploadURL ='http://www.scout.org/home/downloads/audio/model-repository/audio-speech-files'; 
     35my $RepositoryURL ='http://www.repository.voxforge1.org/downloads/SpeechCorpus/Trunk/Audio/Original'; 
    3436my $command; 
    3537#################################################################### 
    …… 
    3739#################################################################### 
    3840sub Main { 
    39         my ($parms,$ProcessedUserSubmissions) = @_; 
     41        my ($parms,%ProcessedUserSubmissions) = @_; 
    4042                my $debug = $$parms{"debug"};            
    41  
    4243        Login($parms);   
    43         foreach my $AudioDirName (keys %$ProcessedUserSubmissions) { 
    44                 my $path_original = $$ProcessedUserSubmissions{$AudioDirName}; 
    45                 print "Update Forum with AudioDirName:$path_original/$AudioDirName\n"; 
     44        foreach my $AudioDirName (keys %ProcessedUserSubmissions) { 
     45                my $path_original = $ProcessedUserSubmissions{$AudioDirName}; 
     46                print STDERR "Update Forum with AudioDirName:$path_original/$AudioDirName\n" if $debug; 
    4647                my ($content,$title)= getContentsofZipFile($parms,$path_original, $AudioDirName); 
    4748                Upload($parms,$content,$title); 
    4849        } 
    49         $command = ("rm my_cookies.txt"); print "$command\n";system($command) == 0 or die "system $command failed: $?";   
     50        $command = ("rm my_cookies.txt"); print "$command\n" if $debug;system($command) == 0 or die "system $command failed: $?";   
    5051} 
    5152 
    …… 
    5657        my ($parms,$path_original, $AudioDirName) = @_; 
    5758                my $debug = $$parms{"debug"}; 
    58                  
    59         my ($content, $title); 
     59 
     60        my ($content, @readme, @prompts, @license); 
     61        my $title=$AudioDirName; 
     62        print STDERR "Extracting :$path_original/$AudioDirName\n" if $debug;   
    6063        my $ae = Archive::Extract->new( archive => "$path_original/$AudioDirName" ); 
    6164        if ( $ae->extract( to => "$AudioDirName-temp" ) ) { 
    62                 $title=$AudioDirName; 
    63                 open(README, "<zipcontents/readme.txt") or confess ("can't find readme.txt");  
    64                 $content .= <README>;         
    65                 open(PROMPTS, "<zipcontents/prompts.txt") or confess ("can't find prompts.txt");  
    66                 $content .= <PROMPTS>;           
    67                 open(LICENSE, "<zipcontents/license.txt") or confess ("can't find license.txt");  
    68                 $content .= <LICENSE>;   
     65                open(README, "<$AudioDirName-temp/readme.txt") or confess ("can't find readme.txt");  
     66                @readme = <README>;         
     67                open(PROMPTS, "<$AudioDirName-temp/prompts.txt") or confess ("can't find prompts.txt");  
     68                @prompts = <PROMPTS>;    
     69                open(LICENSE, "<$AudioDirName-temp/license.txt") or confess ("can't find license.txt");  
     70                @license = <LICENSE>;   
    6971        } else { 
    7072                confess ("can't extract file:$path_original/$AudioDirName") 
    7173        } 
    72                  
     74        $title =~ s/\.zip//; 
     75        $content = join(" ",@readme); 
     76        $content .= "<h2>Prompts:</h2>"; 
     77        $content .= join(" ", @prompts); 
     78        $content .= "<h2>License:</h2>";         
     79        $content .= join(" ",  @license); 
     80        $content =~ s/\n/<br>\n/g;       
     81        $content =~ s/WARRANTY;/WARRANTY,/; # WebGUI does not like CAPITALS followed by semi-colons ...? 
     82        $content =~ s|<http://www.gnu.org/licenses/>|http://www.gnu.org/licenses/|;  # more WebGUI arcana 
     83        $content .= "<br><img src=\"http://www.repository.voxforge1.org/spicons/compressed.gif\">"; 
     84        $content .= "<a href=\"$RepositoryURL/48kHz_16bit/$title.tgz\">$title.tgz</a><br>"; 
     85#       $content = join(" ", 
     86#               @readme,  
     87#               "<h2>Prompts:</h2>", @prompts, 
     88#               "<h2>License:</h2>", @license, 
     89#               "<br> <img src=\"http://www.repository.voxforge1.org/spicons/compressed.gif\" alt=\"[   ]\" border=\"0\">", 
     90#               "<a href=\"http://www.repository.voxforge1.org/downloads/SpeechCorpus/Trunk/Audio/Original/48kHz_16bit/$title.tgz\">$title.tgz</a><br>" 
     91#               ); 
     92 
     93        print $content; 
    7394        return (\$content,\$title); 
    7495} 
    …… 
    7899                my $debug = $$parms{"debug"}; 
    79100                 
     101        my ($result, $err); 
    80102        my $post = "op=auth;method=login;username=test;identifier=test;submit=login"; 
    81103         
    82104        my $curl = new WWW::Curl::Easy; 
    83         $curl->setopt(CURLOPT_URL, $url); 
     105        $curl->setopt(CURLOPT_URL, $LoginURL); 
    84106        $curl->setopt(CURLOPT_COOKIEJAR, "my_cookies.txt"); 
    85107        $curl->setopt(CURLOPT_COOKIEFILE, "my_cookies.txt"); 
    …… 
    89111        $curl->setopt(CURLOPT_POST, 1); 
    90112        $curl->setopt(CURLOPT_POSTFIELDS, $post); 
    91         my $result = $curl->perform; 
    92         my $err; 
     113        $curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk ); 
     114        $curl->setopt(CURLOPT_FILE, \$result); 
     115        $curl->perform; 
    93116        if ($err = $curl->errbuf) { 
    94117                confess ("ERROR: login failed with error: $err\n");  
    95118        } 
    96119        if ($result) { 
    97                 ParseLoginResult($parms, $result); 
     120                ParseLoginResult($parms, \$result); 
    98121        } else { 
    99122                confess ("ERROR: login failed, no result\n") 
    …… 
    101124         
    102125        if ($debug) { 
    103                 print '---------'; 
    104                 my $info = $curl->getinfo(CURLINFO_HTTP_CODE); 
    105                 print "err: $err\n" ; 
    106                 print "info: $info\n" ; 
     126                print "---------\n"; 
     127                print  "err: $err\n" ; 
     128                print "info: $curl->getinfo(CURLINFO_HTTP_CODE\n"; 
     129                # print  "\n\nresult:\n$result\n"; 
    107130        } 
     131        print  "==============================================\n"; 
    108132} 
    109133 
    …… 
    111135        my ($parms, $result) = @_; 
    112136                my $debug = $$parms{"debug"}; 
    113         if ($result =~ /(Hello) <a href=".+">(.+)<\/a>/i) { 
    114                 print "login status: $1\n"; 
     137        if ($$result =~ /(Hello) <a href=".+">(.+)<\/a>/i) { 
     138                print "login status: successful\n"; 
    115139        } else { 
    116                 confess ("ERROR: cannot parse login result; login probably failed\n");  
     140                confess ("ERROR: cannot parse login result; login probably failed\nresult:$$result\n");  
    117141        } 
    118142} 
    …… 
    122146                my $debug = $$parms{"debug"}; 
    123147                         
    124         my $post = "func=editSave;assetId=new;class=WebGUI::Asset::Post::Thread;proceed=showConfirmation;title=\$title;content=\$content;subscribe=1;submit=save"; 
     148        my ($result, $err); 
     149        my $post = "func=editSave;assetId=new;class=WebGUI::Asset::Post::Thread;proceed=showConfirmation;title=$$title;content=$$content;contentType=text,subscribe=1;submit=save"; 
    125150         
    126151        my $curl = new WWW::Curl::Easy; 
    127         $curl->setopt(CURLOPT_URL, $url); 
     152        $curl->setopt(CURLOPT_URL, $UploadURL); 
    128153        $curl->setopt(CURLOPT_COOKIEJAR, "my_cookies.txt"); 
    129154        $curl->setopt(CURLOPT_COOKIEFILE, "my_cookies.txt"); 
    …… 
    133158        $curl->setopt(CURLOPT_POST, 1); 
    134159        $curl->setopt(CURLOPT_POSTFIELDS, $post); 
    135         my $result = $curl->perform; 
    136         my $err;         
     160        $curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk ); 
     161        $curl->setopt(CURLOPT_FILE, \$result); 
     162        $curl->perform; 
    137163        if ($err = $curl->errbuf) { 
    138164                confess ("ERROR: login failed with error: $err");  
    139165        } 
    140166        if ($result) { 
    141                 ParseUploadResult($parms, $result); 
     167                ParseUploadResult($parms, \$result); 
    142168        } else { 
    143169                confess ("ERROR: Upload failed, no result\n") 
    …… 
    145171         
    146172        if ($debug) { 
    147                 print '---------'; 
    148                 my $info = $curl->getinfo(CURLINFO_HTTP_CODE); 
    149                 print "err: $err\n" ; 
    150                 print "info: $info\n" ; 
     173                print  "---------\n"; 
     174                print  "err: $err\n" ; 
     175                print  "info: $curl->getinfo(CURLINFO_HTTP_CODE\n"; 
    151176        } 
    152177} 
    …… 
    155180        my ($parms, $result) = @_; 
    156181                my $debug = $$parms{"debug"}; 
    157                 if ($result =~ /(Your post has been received)/i) { 
    158                         print "upload status: $1\n"; 
    159                 } else { 
    160                         confess ("ERROR: cannot parse upload result; upload probably failed\n");  
    161                 } 
     182        if ($$result =~ /(Your post has been received)/i) { 
     183                print "upload status: $1\n"; 
     184        } elsif ($$result =~ /<h1>(Permission Denied!)<\/h1>/i) { 
     185                print "ERROR: $1\n\nresult:\n$$result\n"; 
     186        } else { 
     187                confess ("ERROR: cannot parse upload result; upload probably failed\nresult:$$result\n");  
     188        } 
     189} 
     190 
     191sub chunk { 
     192        my ($data,$pointer)=@_;  
     193        $$pointer .= $data; 
     194        return length($data); 
    162195} 
    1631961; 
©2005-2008 VoxForge