view release on metacpan or  search on metacpan

bin/html2ps  view on Meta::CPAN

  $conf=<RC>;
  print DBG "***** Global file $globrc:\n$conf" if($opt_d);
  &getconf($conf);
  close RC;
} else {
    # stas: temporarily commented out, since I don't know where this file
    # will be installed on user's system. -- should solve this.
    #&dbg("Warning: cannot open the global resource file: $globrc\n") if($globrc);
}
$html2psrc=~s/^(~|\$HOME)/$ENV{"HOME"}/;
$prc=$html2psrc;
if($opt_f) {
  ($prc=$opt_f)=~s/^:/$html2psrc:/;
  $prc=~s/:$/:$html2psrc/;
  $prc=~s/::/:$html2psrc:/;
}
$cwd=$posix?POSIX::getcwd():"";
opendir(DIR,$cwd);
@local=readdir DIR;
closedir DIR;
$globrc=~/html2psrc/;
$gdir=$`;
$hpath=$ENV{"HTML2PSPATH"}?$ENV{"HTML2PSPATH"}:".:";
$hpath=~s/^:/$gdir:/;
$hpath=~s/:$/:$gdir/;
$hpath=~s/::/:$gdir:/;
$cur=$hpath=~s/(^|:)\.($|:)/$1$cwd$2/;
@hpath=split(/:/,$hpath);
for(@hpath) {
  if(opendir(DIR,$_)) {
    @files=readdir DIR;
    $files{$_}=" @files ";
    closedir DIR;
  }
}
@rc=split(/:/,$prc);
for $rc (@rc) {
  $found=0;
  S:for $dir (@hpath) {
    if(-r $rc && !grep(/^$rc$/,@local) || $files{$dir}=~/ $rc /) {
      chdir $dir if($files{$dir}=~/ $rc / && $cwd);
      if(open(RC,"<$rc")) {
        $conf=<RC>;
        print DBG "***** Personal file $rc:\n$conf" if($opt_d);
        &getconf($conf);
        close RC;
        $found=1;
      }
      last S;
    }
  }
  &dbg("Error opening resource file: $rc\n") if($opt_f && !$found);
}
chdir $cwd if($cwd);
$user=2;
&getconf($opt_S) if($opt_S);
print DBG "*****\n" if($opt_d);
&pagedef;
($pagew,$pageh)=split /\s+/, $AT_page{'size'} if(defined $AT_page{'size'});

require Image::Magick if($package{'PerlMagick'});
$geturl=$package{'geturl'};
$ulanch="f";
$f=72/2.54;
$giftopm="giftopnm" if($package{'netpbm'});
$giftopm="giftoppm" if($package{'pbmplus'});

for(keys %option){eval "\$opt_$_='$option{$_}' if(!defined \$opt_$_)"};
die $usage if $opt_h;
die "$version\n" if $opt_v;
&dbg("$version\n") if ($opt_v||$opt_d);
die "Ghostscript is required to generate DSC PostScript\n"
 if($opt_D && !$package{'Ghostscript'});
die "Ghostscript is required to generate cross references\n"
 if($opt_R && !$package{'Ghostscript'});
$tmpname=$posix?POSIX::tmpnam():"h2p_$$";
($scr=$tmpname)=~/\w+$/;
$tempdir=$`;

if($opt_u) {$ulanch="t"};
if(defined $opt_x && $opt_x!~/^[0-2]$/) {
  die "Illegal duplex value: $opt_x\n";
}
$V='(-?\d+\.?\d*|-?\d*\.?\d+)';
for $o ($opt_s,$opt_i,$opt_m,$opt_N) {
  die "Non numeric: $o\n" if(defined($o) && $o!~/^$V$/);
}

$twoup=$opt_2?"t":"f";
$xp=$extrapage?"t":"f";

die "Invalid option: -W $opt_W\n" if($opt_W!~/^[abflprsL\d]*$/);
$tocdoc=$opt_C=~/[ft]/;
if($tocdoc && !defined $opt_W) {$opt_W=4};
$mult=$#ARGV>0 || $opt_W;
$maxlev=$opt_W=~/(\d+)/?$1:4;
$link=$opt_W=~/l/;
$local=$opt_W=~/s/;
$rel=$opt_W=~/r/;
$below=$opt_W=~/b/;
$layer=$opt_W=~/L/;
$prompt=$opt_W=~/p/;

if($opt_C && $opt_C!~/^(b?[ft]|[ft]b?|b?h|hb?)$/)
  {die "Invalid option: -C $opt_C\n"};
$tc=$opt_C?"t":"f";
$rev=$opt_C=~/t/;
$first=$opt_C=~/b/ || $opt_R;
$th=$tocdoc?"f":"t";
$oeh=0;
$oef=0;

@now=localtime;
@gmnow=gmtime;
POSIX::setlocale(&POSIX::LC_TIME,$locale) if($posix);
$R='(\s*>|[^a-zA-Z0-9>][^>]*>)';
$S='([\w.:/%-]+)|"([^"]*)"|\'([^\']*)\'';
$X='[\da-fA-F]';
$IM='(gif|jpeg|jpg|png|xbm|xpm|ps|eps)';

for('odd-left','odd-center','odd-right','even-left','even-center','even-right')

bin/html2ps  view on Meta::CPAN

  } else {
    $fc=3;
    $pg1="ppm";
    $pg2="";
  }
  ($type)=$URL=~/([^\?]+)\??/;
  ($type)=$type=~/\.(\w+)$/;
  $bm="";
  $ps="";
  $pm="";
  if($opt_U && $src{$URL} && !$cmd{$URL.$red.$grn.$blu}) {
    $pic=$src{$URL};
  } elsif($URL=~m|://|) {
    &geturl($URL,$pic) || return;
  } else {
    $flag=0;
    if($opt_O) {
      $orig=$URL;
      unless($orig=~s/\.\w*$/.ps/) {$orig.=".ps"};
      if(open(ORIG,"<$orig")) {
        $pic=<ORIG>;
        close ORIG;
        if($pic=~/^%!/ && $pic=~/%%BoundingBox:/) {
          $flag=1;
          &dbg("Using $orig as original for $URL\n") if($opt_d);
        }
      }
    }
    if(!$flag) {
      if(open(PIC,"<$URL")) {
        binmode PIC;
        $pic=<PIC>;
        close PIC;
      } else {
        &dbg("*** Error opening $URL\n");
        return;
      }
    }
  }
  $pic=~s/^[\n\r]*//;
  &trans if($pic=~/^GIF/);
  if($pic=~/^P[1-6]/) {
    $pm=$pic;
  } else {
    open(SCRATCH,">$scr");
    binmode(SCRATCH);
    print SCRATCH "$pic";
    close SCRATCH;
    if($pic=~/^%!/ && $pic=~/%%BoundingBox: +$V +$V +$V +$V/) {
      $xs=$3-$1;
      $ys=$4-$2;
      $ps="save\n0 0 M\nIS IS scale\n/showpage {}D\n".(0-$1)." ".(0-$2)." translate\n";
      for $i (split(/\n/,$pic)) {
        $ps.=$i."\n" if($i && $i!~/^%/);
      }
      $ps.="restore";
    } elsif($type=~/.xbm$/i || $pic=~/^#define/) {
      &xbmtops;
    } elsif($package{'ImageMagick'}) {
      if($package{'PerlMagick'}) {
        $imobj=Image::Magick->new;
        $mess=$imobj->Read($scr);
        if($mess) {
          &dbg("$mess\n");
        } else {
          $mess=$imobj->Write("$scr\.$pg1");
          &dbg("$mess\n") if($mess);
        }
        undef $imobj;
      } else {
#        &run("convert $scr $pg1:-");
        &run("convert $scr $scr\.$pg1");
      }
      open(PNM,"$scr\.$pg1");
      binmode PNM;
      $pm=<PNM>;
      close PNM;
      if(!$pm && $pic=~/^\377\330/ && $package{'djpeg'}) {
        &run("djpeg $scr$pg2");
      }
    } elsif($pic=~/^\377\330/ && $package{'djpeg'}) {
      &run("djpeg $scr$pg2");
    } elsif($package{'pbmplus'} || $package{'netpbm'}) {
      if($pic=~/^GIF/) {
        &run("$giftopm $scr");
      } else {
        &run("anytopnm $scr");
      }
      if($opt_g && $pm=~/^P6/) {
        open(SCRATCH,">$scr");
        binmode(SCRATCH); 
        print SCRATCH $pm;
        close SCRATCH;
        &run("ppmtopgm $scr");
      }
    }
  }
  &pmtops if(!$bm);
  return if(!$bm);
  $bm=substr($bm,0,$nd);
  $pad=$nd-length($bm);
  if($pad) {$bm.="f" x $pad};
  $bm=~s/(.{60})/$1\n/g;
}
sub math2sym {
  local($_)=@_;
  s/<math$R//gi;
  for $char (keys %symb) {s/&($char)(;|$|(?=\W))/\\$symb{$char}/g};
  $stat=!/([&<][a-zA-Z]|[_^{])/;
  s/[a-zA-Z\s]*[a-zA-Z][a-zA-Z\s]*/)ES()I($&)ES()SY(/g;
  s/(\\200|\\201|\\202)/)RO($&)ES(/g;
  $sym=")SY($_)ES(";
  $stat;
}
sub varsub {
  for (@_) {
    s/\\\\/\000/g;
    s/\([^)]+\)/()$&join /g;
    s/(^|[^\\])\$(T|N|U|H|A)/$1)join $vars{$2} join(/g;
    s/(^|[^\\])\$D\{"(.*?)"\}/"$1".POSIX::strftime($+,@now)/eg if($posix);
    s/(^|[^\\])\$D/"$1".POSIX::strftime($datefmt,@now)/eg if($posix);