mode_image/zeroconv.pl

   1 #!perl
   2
   3 use CGI::Carp qw(fatalsToBrowser);
   4
   5 use strict;
   6
   7 use Data::Dumper;
   8
   9 print "Content-Type: text/plain\n\n";
  10
  11 my @bump=read_array("bump.txt");
  12 my @threads=glob("res/*.html");
  13 my %bumporder;
  14
  15 for(0..$#bump) { $bumporder{$bump[$_]}=$_; }
  16
  17 foreach my $thread (@threads)
  18 {
  19         my %meta;
  20         my @page=read_array($thread);
  21         my ($num)=$thread=~m!/([0-9]+)!;
  22         my ($title)=$page[1]=~m!<span class="filetitle">\s*(.*?)\s*</span>!;
  23         my ($author)=$page[1]=~m!<span class="postername">\s*(.*?)\s*</span>!;
  24         my ($trip)=$page[1]=~m!<span class="postertrip">\s*(.*?)\s*</span>!;
  25
  26         $meta{lasthit}=$bumporder{$num};
  27         $meta{postcount}=@page-2;
  28         $meta{permasage}=0;
  29         $meta{title}=$title;
  30         $meta{author}=$author.$trip;
  31
  32         $page[0]=~s{\s*<html>}{<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">};
  33         $page[0]=~s!(<input[^>]*[^/])>!$1/>!;
  34         $page[$#page]=~s!(<input[^>]*[^/])>!$1/>!;
  35         $page[$#page]=~s!</form>(\s*<div class="footer")!$1!;
  36
  37         for(1..$#page-1)
  38         {
  39                 $page[$_]=~s!(<img[^>]*[^/])>!$1/>!;
  40         }
  41
  42         print "$thread: $meta{postcount} posts, \"$meta{title}\" by $meta{author}, bumporder $meta{lasthit}\n";
  43
  44         unshift @page,make_meta_header(%meta);
  45         write_array("_$thread",@page);
  46 }
  47
  48 print "\n\n=== Done ===";
  49
  50
  51
  52
  53
  54 sub make_meta_header(%)
  55 {
  56         my (%meta)=@_;
  57         $Data::Dumper::Terse=1;
  58         $Data::Dumper::Indent=0;
  59         return '<!-- '.Dumper(\%meta).' -->';
  60 }
  61
  62 sub read_array($)
  63 {
  64         my ($file)=@_;
  65
  66         if(ref $file eq "GLOB")
  67         {
  68                 return map { s/\r?\n?$//; $_ } <$file>;
  69         }
  70         else
  71         {
  72                 open FILE,$file or return ();
  73                 my @array=map { s/\r?\n?$//; $_ } <FILE>;
  74                 close FILE;
  75                 return @array;
  76         }
  77 }
  78
  79 sub write_array($@)
  80 {
  81         my ($file,@array)=@_;
  82
  83         if(ref $file eq "GLOB")
  84         {
  85                 print $file join "\n",@array;
  86         }
  87         else
  88         {
  89                 open FILE,">$file" or die "Couldn't write to directory";
  90                 print FILE join "\n",@array;
  91                 close FILE;
  92         }
  93 }