Navigation

← Previous Changeset
Next Changeset →

Changeset 2450

Timestamp:

02/27/08 23:16:44 (11 months ago)

Author:

kmaclean

Message:

WebGUIForum update:converted from WWW::Curl::Easy to LWP::UserAgent? (more documentation available for LWP)

Files:

Trunk/Scripts/Mirroring_scripts/Single_WebGUIForum.pm (modified) (3 diffs)
Trunk/Scripts/Mirroring_scripts/WebGUIForum.pm (modified) (13 diffs)

Legend:

: Unmodified
: Added
: Removed
: Modified
: Copied
: Moved

Trunk/Scripts/Mirroring_scripts/Single_WebGUIForum.pm

r2434	r2450
37	37	### Directory
38	38	####################################################################
39		my $AudioDirName="delibab-20071020";
40		my $path_original ="/data/svn-mirror/SpeechCorpus/Trunk/Audio/Original/44.1kHz_16bit";
	39	my $AudioDirName="anonymous-20080213-kpq";
	40	my $path_original ="/home/kmaclean/VoxForge-dev/Main/Scripts/Mirroring_scripts";
	41	my $promptsfile = "prompts.txt";
	42	my $readmefile = "readme.txt";
	43	my $licensefile = "license.txt";
	44	my $tarfile ="$path_original/$AudioDirName.zip"; # if blank than attachment does not get processed by LWP!
41	45	####################################################################
42	46	### Main
43	47	####################################################################
44		my $readme = UserSubmission::README->new($parms, "$path_original/$AudioDirName/~~etc/README~~");
	48	my $readme = UserSubmission::README->new($parms, "$path_original/$AudioDirName/$readmefile");
45	49	$ProcessedUserSubmissions{$AudioDirName}= {
46	50	"path_original" => $path_original,
47	51	"readme" => $readme
48	52	};
49		Update($parms, \%ProcessedUserSubmissions, 'speechsubmission', '~~xxxxxxxxx~~') \|\| confess "Single_WebGUIForumUpdate error: $?";
	53	Update($parms, \%ProcessedUserSubmissions, 'speechsubmission', 'n@wp@$$') \|\| confess "Single_WebGUIForumUpdate error: $?";
50	54
51	55	print "completed\n";
…	…
56	60	my ($parms,$ProcessedUserSubmissions, $username, $identifier) = @_;
57	61	my $debug = $$parms{"debug"};
58		print "\n~~Single_WebGUIForum~~.pm starting****************************************************\n\n";
	62	print "\nWebGUIForumUpdate.pm starting****************************************************\n\n";
59	63	my $counter;
60		WebGUIForum::Login($parms, $username, $identifier);
	64
	65	my $browser = LWP::UserAgent->new(keep_alive => 1 );
	66	$browser->cookie_jar( {} );
	67	WebGUIForum::Login($parms, $browser, $username, $identifier);
61	68	foreach my $AudioDirName (keys %$ProcessedUserSubmissions) {
62	69	$counter++;
…	…
66	73	#if(($readme->getAudiorecordingsoftware() =~ /VoxForge Speech Submission Application/) or ($readme->getUpdatewebguiforum() =~ /y/i)){
67	74	print STDERR "Update Forum with AudioDirName:$path_original/$AudioDirName\n" if $debug;
68		my ($content,$title)= WebGUIForum::getSubmissionContents($parms,$path_original,$AudioDirName,$readme);
69		WebGUIForum::Upload($parms,$content,$title,$readme);
	75	#my $readmepath = "$path_original/$AudioDirName/etc/README";
	76	#my $promptspath = "$path_original/$AudioDirName/etc/prompts-original";
	77	#my $licensepath = "$path_original/$AudioDirName/LICENSE";
	78	my $promptspath = "$path_original/$AudioDirName/$promptsfile";
	79	my $readmepath = "$path_original/$AudioDirName/$readmefile";
	80	my $licensepath = "$path_original/$AudioDirName/$licensefile";
	81	my $repositoryUrl = "no";
	82	my ($content,$title)= WebGUIForum::getSubmissionContents($parms,$readmepath,$promptspath,$licensepath,$AudioDirName, $readme,$repositoryUrl);
	83	WebGUIForum::Upload($parms,$browser,$content,$title,$readme,$tarfile);
70	84	#} else {
71	85	# print "No WebGUI Forum Update - not submitted using VoxForge Speech Submission Application, or flagged for webgui forum update\n";
72	86	#}
73	87	}
74		$command = ("rm my_cookies.txt"); print "$command\n" if $debug;system($command) == 0 or die "system $command failed: $?";
75		print "\nSingle_WebGUIForum.pm completed!****************************************************\n\n";
	88	print "\nWebGUIForumUpdate.pm completed!\n****************************************************\n\n";
76	89	}

Trunk/Scripts/Mirroring_scripts/WebGUIForum.pm

r2435	r2450
3	3	###
4	4	### script name : WebGUIForum.pm
5		### version: 0.1
	5	### version: 0.1.1
6	6	### created by: Ken MacLean
7	7	### mail: contact@voxforge.org
…	…
21	21	### GNU General Public License for more details.
22	22	###
	23	### Change History:
	24	### 0.1.1 - 2008.2.27 - converted from WWW::Curl::Easy to LWP::UserAgent (more documentation available for LWP)
23	25	####################################################################
24	26	package WebGUIForum;
…	…
26	28	use Carp;
27	29	use strict;
28		use WWW::Curl::Easy;
	30	# !!!!!!
	31	#use WWW::Curl::Easy;
	32	use LWP::UserAgent;
	33	use URI::Escape;
29	34	#use Archive::Extract;
	35	# !!!!!!
30	36	####################################################################
31	37	### Declarations
32	38	####################################################################
	39	my $command;
33	40	my $LoginURL ='http://www.voxforge.org';
34		my $command;
	41	#my $englishURL = 'http://www.voxforge.org/home/downloads/speech/english';
	42	#my $dutchURL = 'http://www.voxforge.org/home/downloads/speech/dutch';
	43	my $englishURL = 'http://www.voxforge.org/home/downloads/speech/voxforgeivr'; # for testing
	44	my $dutchURL = 'http://www.voxforge.org/home/downloads/speech/voxforgeivr'; # for testing
	45	my $tarfile = "none";
35	46	####################################################################
36	47	### Main
…	…
41	52	print "\nWebGUIForumUpdate.pm starting****************************************************\n\n";
42	53	my $counter;
43		Login($parms, $username, $identifier);
	54	# !!!!!!
	55	# Login($parms, $username, $identifier);
	56	my $browser = LWP::UserAgent->new(keep_alive => 1 );
	57	$browser->cookie_jar( {} );
	58	Login($parms, $browser, $username, $identifier);
	59	# !!!!!!
44	60	foreach my $AudioDirName (keys %$ProcessedUserSubmissions) {
45	61	$counter++;
…	…
49	65	if(($readme->getAudiorecordingsoftware() =~ /VoxForge Speech Submission Application/) or ($readme->getUpdatewebguiforum() =~ /y/i)){
50	66	print STDERR "Update Forum with AudioDirName:$path_original/$AudioDirName\n" if $debug;
51		my ($content,$title)= getSubmissionContents($parms,$path_original,$AudioDirName,$readme);
52		Upload($parms,$content,$title,$readme);
	67	my $readmepath = "$path_original/$AudioDirName/etc/README";
	68	my $promptspath = "$path_original/$AudioDirName/etc/prompts-original";
	69	my $licensepath = "$path_original/$AudioDirName/LICENSE";
	70	my $repositoryUrl = "yes";
	71	my ($content,$title)= getSubmissionContents($parms,$readmepath,$promptspath,$licensepath,$AudioDirName,$readme,$repositoryUrl);
	72	Upload($parms,$browser,$content,$title,$readme,$tarfile);
53	73	} else {
54	74	print "No WebGUI Forum Update - not submitted using VoxForge Speech Submission Application, or flagged for webgui forum update\n";
55	75	}
56	76	}
57		$command = ("rm my_cookies.txt"); print "$command\n" if $debug;system($command) == 0 or die "system $command failed: $?";
58		print "\nWebGUIForumUpdate.pm completed!****************************************************\n\n";
	77	#$command = ("rm my_cookies.txt"); print "$command\n" if $debug;system($command) == 0 or die "system $command failed: $?";
	78	print "\nWebGUIForumUpdate.pm completed!\n****************************************************\n\n";
59	79	}
60	80
…	…
68	88	# remember to change LoginURL above if changing here:
69	89	if ($readme->getLanguage() =~ /EN/) {
70		$UploadURL =~~'http://www.voxforge.org/home/downloads/speech/english'~~;
	90	$UploadURL =$englishURL;
71	91	} elsif ($readme->getLanguage() =~ /NL/) {
72		$UploadURL =~~'http://www.voxforge.org/home/downloads/speech/dutch'~~;
	92	$UploadURL =$dutchURL;
73	93	} else {
74		$UploadURL =~~'http://www.voxforge.org/home/downloads/speech/english'~~;
	94	$UploadURL =$englishURL;
75	95	}
76	96	return $UploadURL;
…	…
78	98
79	99	sub getSubmissionContents {
80		my ($parms,$path_original, $AudioDirName,$readme) = @_;
	100	# !!!!!!
	101	#my ($parms,$readmepath,$promptspath,$licensepath,$AudioDirName,$readme) = @_;
	102	my ($parms,$readmepath,$promptspath,$licensepath,$AudioDirName,$readme,$repositoryUrl) = @_;
	103	# !!!!!!
81	104	my $debug = $$parms{"debug"};
82	105	my ($content, @readme, @prompts, @license,$AudioRecordingSoftware,$language,$RepositoryURL);
…	…
88	111	#if ( $ae->extract( to => "$AudioDirName-temp" ) ) {
89	112	# open(README, "<$AudioDirName-temp/readme.txt") or confess ("can't find readme.txt");
90		open(README, "<$~~path_original/$AudioDirName/etc/README~~") or confess ("can't find readme.txt");
	113	open(README, "<$readmepath") or confess ("can't find readme.txt");
91	114	@readme = <README>;
92	115	$RepositoryURL = getRepositoryURL($parms,$readme);
93		open(PROMPTS, "<$p~~ath_original/$AudioDirName/etc/prompts-original~~") or confess ("can't find prompts.txt");
	116	open(PROMPTS, "<$promptspath") or confess ("can't find prompts.txt");
94	117	@prompts = <PROMPTS>;
95		open(LICENSE, "<$~~path_original/$AudioDirName/LICENSE~~") or confess ("can't find license.txt");
	118	open(LICENSE, "<$licensepath") or confess ("can't find license.txt");
96	119	@license = <LICENSE>;
97	120	#} else {
…	…
106	129	$content =~ s/\n/<br>\n/g;
107	130	$content =~ s\|<http://www.gnu.org/licenses/>\|http://www.gnu.org/licenses/\|; # either webgui or libcurl issue
108		$content .= "<br><img src=\"http://www.repository.voxforge1.org/spicons/compressed.gif\">";
109		$content .= "<a href=\"$RepositoryURL/$title.tgz\">$title.tgz</a><br>";
110		$content =~ s/;/,/g; # CURL submission options are separated by a semi-colon, therefore no semi-colons allowed in content submitted to WebGUI
111		$content =~ s/&/and/g; # CURL (or WebGUI) doesn't like ampersands??
	131	if ($repositoryUrl eq "yes") {
	132	$content .= "<br><img src=\"http://www.repository.voxforge1.org/spicons/compressed.gif\">";
	133	$content .= "<a href=\"$RepositoryURL/$title.tgz\">$title.tgz</a><br>";
	134	}
	135	# !!!!!!
	136	# CURL expects URL encoded data for get; but does not need it for a post!
	137	# therefore, don't need to use: "use URI::Escape;"
	138	# encoded_string = uri_escape(raw_string);
	139	#$content =~ s/;/,/g; # CURL submission options are separated by a semi-colon, therefore no semi-colons allowed in content submitted to WebGUI
	140	#$content =~ s/&/and/g; # CURL (or WebGUI) doesn't like ampersands??
	141	# !!!!!!
112	142	return (\$content,\$title);
113	143	}
…	…
117	147	my $debug = $$parms{"debug"};
118	148	my $RepositoryURL;
119		~~# !!!!!!~~
120	149	my $AudioRateDir = $readme->getSamplingrate() . "_" . $readme->getSamplingrateformat() ;
121		~~# !!!!!!~~
122	150	if ($readme->getLanguage() =~ /EN/) {
123		~~# !!!!!!~~
124		~~# $RepositoryURL ='http://www.repository.voxforge1.org/downloads/SpeechCorpus/Trunk/Audio/Original/48kHz_16bit';~~
125	151	$RepositoryURL ="http://www.repository.voxforge1.org/downloads/SpeechCorpus/Trunk/Audio/Original/$AudioRateDir";
126		~~# !!!!!!~~
127	152	} elsif ($readme->getLanguage() =~ /NL/) {
128	153	$RepositoryURL = "Dutch submissions not set up yet in Repository yet!\n";
129	154	print "WARNING: Dutch submissions not set up yet in Repository yet!\n";
130	155	} else {
131		~~# !!!!!!~~
132		~~#$RepositoryURL ='http://www.repository.voxforge1.org/downloads/SpeechCorpus/Trunk/Audio/Original/48kHz_16bit';~~
133	156	$RepositoryURL ="http://www.repository.voxforge1.org/downloads/SpeechCorpus/Trunk/Audio/Original/$AudioRateDir";
134		~~# !!!!!!~~
135	157	}
136	158	return $RepositoryURL;
…	…
138	160
139	161	sub Login {
140		my ($parms, $username, $identifier) = @_;
141		my $debug = $$parms{"debug"};
142		my ($result, $err);
143		my $post = "op=auth;method=login;username=$username;identifier=$identifier;submit=login";
	162	# !!!!!!
	163	#my ($parms, $username, $identifier) = @_;
	164	my ($parms, $browser, $username, $identifier) = @_;
	165	my $debug = $$parms{"debug"};
	166	#my ($result, $err);
	167	#my $post = "op=auth;method=login;username=$username;identifier=$identifier;submit=login";
144	168
145		my $curl = new WWW::Curl::Easy;
146		$curl->setopt(CURLOPT_URL, $LoginURL);
147		$curl->setopt(CURLOPT_COOKIEJAR, "my_cookies.txt");
148		$curl->setopt(CURLOPT_COOKIEFILE, "my_cookies.txt");
149		$curl->setopt(CURLOPT_CONNECTTIMEOUT, 120);
150		$curl->setopt(CURLOPT_TIMEOUT, 10);
151		$curl->setopt(CURLOPT_FOLLOWLOCATION,1);
152		$curl->setopt(CURLOPT_POST, 1);
153		$curl->setopt(CURLOPT_POSTFIELDS, $post);
154		$curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk );
155		$curl->setopt(CURLOPT_FILE, \$result);
156		$curl->perform;
157		if ($err = $curl->errbuf) {
158		confess ("ERROR: login failed with error: $err\n");
159		}
160		if ($result) {
161		ParseLoginResult($parms, \$result);
162		} else {
163		confess ("ERROR: login failed, no result\n")
	169	#my $curl = new WWW::Curl::Easy;
	170	#$curl->setopt(CURLOPT_URL, $LoginURL);
	171	#$curl->setopt(CURLOPT_COOKIEJAR, "my_cookies.txt");
	172	#$curl->setopt(CURLOPT_COOKIEFILE, "my_cookies.txt");
	173	#$curl->setopt(CURLOPT_CONNECTTIMEOUT, 120);
	174	#$curl->setopt(CURLOPT_TIMEOUT, 10);
	175	#$curl->setopt(CURLOPT_FOLLOWLOCATION,1);
	176	#$curl->setopt(CURLOPT_POST, 1);
	177	#$curl->setopt(CURLOPT_POSTFIELDS, $post);
	178	#$curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk );
	179	#$curl->setopt(CURLOPT_FILE, \$result);
	180	#$curl->perform;
	181	#if ($err = $curl->errbuf) {
	182	# confess ("ERROR: login failed with error: $err\n");
	183	#}
	184	#if ($result) {
	185	# ParseLoginResult($parms, \$result);
	186	#} else {
	187	# confess ("ERROR: login failed, no result\n")
	188	#}
	189	my $result = $browser->post(
	190	"$LoginURL",
	191	[
	192	'op' => 'auth',
	193	'method' => 'login',
	194	'username' => "$username",
	195	'identifier' => "$identifier",
	196	'submit' => 'login'
	197	],
	198	);
	199	if ($result->is_success) {
	200	ParseLoginResult($parms, $result);
	201	}
	202	else {
	203	confess ("ERROR: login failed; status line:$result->status_line\n")
164	204	}
165	205
166	206	if ($debug) {
167	207	print "---------\n";
168		print "err: $err\n" ;
169		print "http code:" . $curl->getinfo(CURLINFO_HTTP_CODE). "\n";
	208	#print "err: $err\n" ;
	209	#print "http code:" . $curl->getinfo(CURLINFO_HTTP_CODE). "\n";
	210	print "http code:" . $result->status_line. "\n";
170	211	# print "\n\nresult:\n$result\n";
171	212	}
	213	# !!!!!!
172	214	}
173	215
…	…
175	217	my ($parms, $result) = @_;
176	218	my $debug = $$parms{"debug"};
177		if ($$result =~ /(Hello) <a href=".+">(.+)<\/a>/i) {
	219	# !!!!!!!
	220	#if ($$result =~ /(Hello) <a href=".+">(.+)<\/a>/i) {
	221	if ($result->content =~ /(Hello) <a href=".+">(.+)<\/a>/i) {
178	222	print "login status: successful\n";
179	223	} else {
180		confess ("ERROR: cannot parse login result; login probably failed\nresult:$$result\n");
181		}
	224	#confess ("ERROR: cannot parse login result; login probably failed\nresult:$$result\n");
	225	confess ("ERROR: cannot parse login result; login probably failed\nresult:$result->content\n");
	226	}
	227	# !!!!!!
182	228	}
183	229
184	230	sub Upload {
185		my ($parms,$~~content,$title,$readm~~e) = @_;
186		my $debug = $$parms{"debug"};
187		~~my ($result, $err~~);
188		~~my $post = "func=editSave;assetId=new;class=WebGUI::Asset::Post::Thread;proceed=showConfirmation;title=$$title;content=$$content;contentType=text,subscribe=1;submit=save";~~
189		~~my $UploadURL = getUploadURL($parms,$readme);~~
	231	my ($parms,$browser,$content,$title,$readme,$tarfile) = @_;
	232	my $debug = $$parms{"debug"};
	233	#my ($result, $err, $post);
	234	# if (($tarfile ne "none") and (defined($tarfile)) and ($tarfile ne "")) {
	235	#$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";
190	236
191		my $curl = new WWW::Curl::Easy;
192		$curl->setopt(CURLOPT_URL, $UploadURL);
193		$curl->setopt(CURLOPT_COOKIEJAR, "my_cookies.txt");
194		$curl->setopt(CURLOPT_COOKIEFILE, "my_cookies.txt");
195		$curl->setopt(CURLOPT_CONNECTTIMEOUT, 120);
196		$curl->setopt(CURLOPT_TIMEOUT, 28800);
197		$curl->setopt(CURLOPT_FOLLOWLOCATION,1);
198		$curl->setopt(CURLOPT_POST, 1);
199		$curl->setopt(CURLOPT_POSTFIELDS, $post);
200		$curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk );
201		$curl->setopt(CURLOPT_FILE, \$result);
202		$curl->perform;
203		if ($err = $curl->errbuf) {
204		confess ("ERROR: login failed with error: $err");
205		}
206		if ($result) {
207		ParseUploadResult($parms, \$result);
208		} else {
209		confess ("ERROR: Upload failed, no result\n")
210		}
211
	237	#my $curl = new WWW::Curl::Easy;
	238	#$curl->setopt(CURLOPT_URL, $UploadURL);
	239	#$curl->setopt(CURLOPT_COOKIEJAR, "my_cookies.txt");
	240	#$curl->setopt(CURLOPT_COOKIEFILE, "my_cookies.txt");
	241	#$curl->setopt(CURLOPT_CONNECTTIMEOUT, 120);
	242	#$curl->setopt(CURLOPT_TIMEOUT, 28800);
	243	#$curl->setopt(CURLOPT_FOLLOWLOCATION,1);
	244	#$curl->setopt(CURLOPT_HTTPPOST, 1);
	245	#$curl->setopt(CURLOPT_POSTFIELDS, $post);
	246	#$curl->setopt(CURLOPT_WRITEFUNCTION, \&chunk );
	247	#$curl->setopt(CURLOPT_FILE, \$result);
	248	#$curl->perform;
	249	my $result = $browser->post(
	250	getUploadURL($parms,$readme),
	251	[
	252	'func' => 'editSave',
	253	'assetId' => 'new',
	254	'class' => 'WebGUI::Asset::Post::Thread',
	255	'proceed' => 'showConfirmation',
	256	'title' => "$$title",
	257	'content' => "$$content",
	258	'storageId_file' => ["$tarfile"],
	259	'__storageId_action' => 'upload',
	260	'subscribe' => '1',
	261	'submit' => 'save',
	262	],
	263	'Content_Type' => 'form-data',
	264	);
	265	#if ($err = $curl->errbuf) {
	266	# confess ("ERROR: login failed with error: $err");
	267	#}
	268	#if ($result) {
	269	# ParseUploadResult($parms, \$result);
	270	#} else {
	271	# confess ("ERROR: Upload failed, no result\n")
	272	#}
	273	if ($result->is_success) {
	274	ParseUploadResult($parms, $result);
	275	}
	276	else {
	277	confess ("ERROR: login failed; status line:" . $result->status_line . "\n")
	278	}
212	279	if ($debug) {
213	280	print "---------\n";
214		print "err: $err\n" ;
215		print "http code:" . $curl->getinfo(CURLINFO_HTTP_CODE). "\n";
	281	#print "err: $err\n" ;
	282	#print "http code:" . $curl->getinfo(CURLINFO_HTTP_CODE). "\n";
	283	print "http code:" . $result->status_line. "\n";
216	284	}
217	285
…	…
222	290	my $debug = $$parms{"debug"};
223	291
224		if ($$result =~ /(Your post has been received)/i) {
	292	#if ($$result =~ /(Your post has been received)/i) {
	293	if ($result->content =~ /(Your post has been received)/i) {
225	294	print "upload status: $1\n";
226		} elsif ($$result =~ /<h1>(Permission Denied!)<\/h1>/i) {
227		print "ERROR: $1\n\nresult:\n$$result\n";
	295	#} elsif ($$result =~ /<h1>(Permission Denied!)<\/h1>/i) {
	296	} elsif ($result->content =~ /<h1>(Permission Denied!)<\/h1>/i) {
	297	#print "ERROR: $1\n\nresult:\n$$result\n";
	298	confess "ERROR: $1\n\nresult:\n$result->content\n";
228	299	} else {
229		confess ("ERROR: cannot parse upload result; upload probably failed\nresult:$$result\n");
230		}
231		}
232
233		sub chunk {
234		my ($data,$pointer)=@_;
235
236		$$pointer .= $data;
237		return length($data);
238		}
	300	#confess ("ERROR: cannot parse upload result; upload probably failed\nresult:$$result\n");
	301	confess ("ERROR: cannot parse upload result; upload probably failed\nresult:$result->content\n");
	302	}
	303	}
	304	# !!!!!!
	305	#sub chunk {
	306	# my ($data,$pointer)=@_;
	307	# $$pointer .= $data;
	308	# return length($data);
	309	#}
	310	# !!!!!!
239	311	1;

Dev Site (Scripts)

Navigation

Changeset 2450

Legend:

Trunk/Scripts/Mirroring_scripts/Single_WebGUIForum.pm

Trunk/Scripts/Mirroring_scripts/WebGUIForum.pm

Download in other formats: