# Slashlib a library for using slashdot from perl programs
# Code contributed by most of the regulars on sid=slashcode

# Things to do....
# Make this into a proper perl module
# Provide POD documentation
# Think up more aubroutines to add...userinfo, search, 

$slashdot = 'http://slashdot.org/'; 
$sidref = 'comments.pl?threshold=-1&mode=nested&commentsort=1&sid='; 
$user_agent = "Slashlib 0.2";

# sd_articles: return a list of recent Slashdot article sids 
sub sd_articles { 
   my ($source, @articles); 
   $source = shift || "comments.pl"; 
   my $out=geturl($slashdot.$source,$slashdot);
   while($out =~ m/article\.pl\?sid=([^">]+)/g){ 
      push @articles, $1;  
   } 
   return @articles; 
}

# Return SID at top of slashdot.org
sub sd_current_sid{
	my $out=get_url("$slashdot");
	$out =~ /sid=(.*?)"><b>Read/i;
	return $1;
}

# Return moderation totals on post
sub sd_mods { 
  my $sid = shift;
  my $cid = shift;
  my $out=geturl($slashdot.$sidref.escape($sid)."\&cid=$cid",$slashdot);
  if ($out =~ m#Totals</B></FONT>:([^<]+)#) { 
      return $1; 
   } 
} 

# Return information about a sid 
sub sd_sidinfo { 
   my ($sid) = shift; 
   my ($i, %counts); 
   my $out=geturl($slashdot.$sidref.$sid ,$slashdot);
   $out=~ m/Threshold: <SELECT NAME="threshold">(.*?)<\/SELECT>/i;
   my $options=$1;
   for ($i = -1; $i < 5;++$i) { 
      $options =~ /$i: (\d+)/;
      $counts{$i} = $1; 
   } 
   return %counts; 
} 

# Get comment -- needs work (does it work?)
sub sd_getcomment { 
   my ($sid) = shift || "slashlibtest"; 
   my ($cid) = shift || "1"; 
   my (%comment, $i); 
   my $out=geturl($slashdot.$sidref.$sid."\&cid=$cid");
   @out=split(/\n/, $out);
   while($_=shift(@out)) { 
      if ($comment{'cid'} eq '' and m/<A name="([^>]+)"><B>([^<]+)/) { 
         $comment{'cid'} = $1; 
         $comment{'subject'} = $2; 
# Needs to be fixed to correctly handle HTML in comments 
#} elsif ($comment{'body'} eq '' and m/<TR><TD bgcolor=ffffff>([^<]+)/){ 
# $comment{'body'} = $1; 
      } elsif ($comments{'body'} eq '' and m/<TR><TD bgcolor=ffffff>/) { 
         $i = length("<TR><TD bgcolor=ffffff>") + 1; 
         m/<TR><TD bgcolor=ffffff>(.+?)(<\/TD>)?/; 
         $comments{'body'} = $1;
		 print $1; 
# Read until </TD> 
         while($_=shift(@out)) { 
            m/(.+?)<\/TD>/; 
            $comments{'body'} .= $1; 
         } 
         print "COMMENTS: $comments{'body'}\n"; 
      } elsif ($comment{'mods'} eq '' and m#Totals:</B></FONT>:([^<>]+)#) { 
         $comment{'mods'} = $1; 
         print "Moderation: $1\n"; 
      } 
   } 
   print<<EOT; 
Sid: $sid 
Cid: $comment{'cid'} 
Subject: $comment{'subject'} 
Body: $comment{'body'} 
Moderation: $comment{'mods'} 
EOT
} 

# Returns a formkey for the sid specified (used by sd_postcomment
sub sd_formkey{
   my $sid=shift;
   my $key=get_url($slashdot.$sidref.escape($sid)."\&op=Reply");
   $key =~ /<INPUT type="hidden" name="formkey" value="(.*?)">/;
   return $1;
}


# Gets the url given, optionally sending a referer
sub get_url{
	my $url=shift;
	my $ref=shift || $slashdot;
	my $out;
	my $ok;
	$url =~ /^http:\/\/(.*?)\/(.*?)$/;
	my $host=$1;
	my $local="/".$2;
	if($host =~ /:(\d+)$/){$port=$1}else{$port=80}
	$http=IO::Socket::INET->new(
 		PeerAddr  => "$host",
 		Proto     => "tcp",
 		PeerPort  => "$port",
 		Timeout   => 30) or die "Unable to connect to $host";
	print $http "GET $local HTTP/1.0\nUser-agent: $user_agent\nReferer: $ref\n\n";
	while(<$http>){
	     if(!$ok and /:/){}
		 elsif(!$ok){$ok=1}
		 else{
			$out.=$_;
		 }
	}
	return($out);
}

sub post_url{
   my $url=shift;
   my $submit=shift;
   my $ref=shift || $slashdot;
   my ($out,$ok);
   $url =~ /^http:\/\/(.*?)\/(.*?)$/;
   my $host=$1;
   my $local="/".$2;
   if($host =~ /:(\d+)$/){$port=$1}else{$port=80}
   my $http=IO::Socket::INET->new(
		 PeerAddr  => $host,
		 Proto     => "tcp",
		 PeerPort  => $port,
		 Timeout   => 30) or die "Unable to connect to $host";
   print $http <<EOF;
POST $local HTTP/1.0
User-agent: $user_agent
Referer: $ref
Content-type: application/x-www-form-urlencoded
EOF
   print $http "Content-length: ",length($submit),"\n\n",$submit,"\n";
   while(<$http>){
	  if(!$ok and /:/){}
	  elsif(!$ok){$ok=1}
	  else{
		 $out.=$_;
	  }
   }
   return $out;
}

# URL-encode data (from CGI.pm)
sub escape {
   my $toencode = shift;
   $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
   return $toencode;
}