#!/usr/bin/perl# massage B.E.J. in Economic Analysis & Policy XML files# MUST RUN ON SOLARIS TO DEAL WITH UNICODE ISSUESprint "\nbejeap v1.1.1\n\n";print "C F Baum  Apr 2002\n\n";use LWP::Simple;use Text::Wrap;$str = get("http://www.bepress.com/cgi/oai.cgi?verb=ListRecords&metadataPrefix=repec&set=publication:62656a656170");# set up for three journals$out[0]=">bejeap-adv.rdf";$jnl[0]="Advances in Economic Analysis & Policy";$han[0]="eapadv";open(OUTA,$out[0]) || die "Cannot open $outa for output";$out[1]=">bejeap-con.rdf";$jnl[1]="Contributions to Economic Analysis & Policy";$han[1]="eapcon";open(OUTC,$out[1]) || die "Cannot open $outc for output";$out[2]=">bejeap-top.rdf";$jnl[2]="Topics in Economic Analysis & Policy"; $han[2]="eaptop";open(OUTT,$out[2]) || die "Cannot open $outt for output";$nrtem=0;$str =~ s/\n/ /ig;$str =~ s/\r/ /ig;$str =~ s/&amp;/&/ig;$str =~ s/&quot;/"/ig;$str =~ s/^.+?<record>//;(@str) = split("<record>",$str);$nstr=@str;print "\n $nstr articles...\n\n";$debug=1;foreach $str (@str) {	$str=&utf8_to_iso8859($str);	($id) = ($str =~ /<identifier>oai:bepress:(.+?)<\/identifier/);	($credt) = ($str =~ /<datestamp>(.+?)<\/datestamp/);	($pubyr) = ($credt =~ /^(\d\d\d\d)/);	($ti) = ($str =~ /<ti>(.+?)<\/ti/);	(@au) = ($str =~ /<au>(.+?)<\/au/ig);	$nau = @au;	($ab) = ($str =~ /<ab>(.+?)<\/ab/);	($jnl) = ($str =~ /<jrnti>(.+?)<\/jrnti/);	($vol) = ($str =~ /<vol>(.+?)<\/vol/);	($iss) = ($str =~ /<iss>(.+?)<\/iss/);	($ppf) = ($str =~ /<ppf>(.+?)<\/ppf/);	($ppl) = ($str =~ /<ppl>(.+?)<\/ppl/);	($url) = ($str =~ /<url>(.+?)<\/url/);	($jj) = ($jnl =~ /^(A|C|T)/);	$wh = 0;	if ($jj eq "C") {$wh=1};	if ($jj eq "T") {$wh=2};	print "$id $jnl \n";	(@kw) = ($str =~ /<kwd>(.+?)<\/kwd/ig);	$nkw = @kw;	($jel) = ($str =~ /<categ>(.+?)<\/categ/);	$oo = "OUT".$jj;	$jt = $jnl[$wh];	$hl = $han[$wh];	print $oo "\nTemplate-Type: ReDIF-Article 1.0\n";	print $oo "Title: $ti\n";	foreach $i (@au) {		($f) = ($i =~ m/fnm>(.+?)<\/fnm/ig);		($l) = ($i =~ m/snm>(.+?)<\/snm/ig);		($afl) = ($i =~ m/affl>(.+?)<\/affl/ig);	print $oo "Author-Name: $f $l \n";	print $oo "Author-Workplace-Name: $afl \n";	}	if (length $ab > 1) {		print $oo  "Abstract:\n";		print $oo  wrap(" "," ",$ab);		print $oo "\n";	}	if ($nkw > 0) {		print $oo "Keywords: ";		foreach $k (@kw) {			print $oo "$k, ";			}		print $oo "\n";	}	print $oo "Classification-JEL: $jel \n";	print $oo "Journal: $jt \n";	print $oo "Year: $pubyr \n";	print $oo "Issue: $iss \n";	print $oo "Volume: $vol \n";	print $oo "Pages: $ppf-$ppl \n";	print $oo "Note: oai:bepress:$id\n";	print $oo "File-URL: $url \n";	print $oo "File-Format: application/pdf \n";	print $oo "Handle: RePEc:bep:$hl:v:$vol:y:$pubyr:i:$iss:p:$ppf-$ppl \n";	$nrtem++;}print " \n$nrtem templates processed... \n\n";exit;sub utf8_to_iso8859{# Converts UTF-8 as long as it just encodes ISO-8859-1	my ($str) = @_;	my $retval;	my @chars = split(//,$str);	while (@chars) {		my $ch = shift(@chars);		my $val1 = ord($ch);		if($val1 >= 128) {			# XXXX could add error checking to make sure there's a char available.			my $val2 = ord(shift(@chars));			$val1 = ($val1 & 31) << 6;			$val2 &= 63;			my $realch = chr($val1 + $val2);			print STDERR "Hello: converted upper ascii char $realch(", ord($realch), ")\n" if ($debug);			$retval .= $realch;		} else {			$retval .= $ch;		}	}	return $retval;}__END__