view release on metacpan or  search on metacpan

doc/html2ps  view on Meta::CPAN

$user=1;
if(open(RC,$globrc)) {
  $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::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 /);
      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;
$user=2;
&getconf($opt_S) if($opt_S);
print DBG "*****\n" if($opt_d);

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_$_)"};
($scr=POSIX::tmpnam())=~/\w+$/;
$tempdir=$`;
die $usage if $opt_h;
&dbg("$version\n") if ($opt_v||$opt_d);
for ('left','right','top','bottom') {
  $body{"margin-$_"}=$margin{$_} if(!defined $body{"margin-$_"});
}
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=$toc{'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;
POSIX::setlocale(&POSIX::LC_TIME,$locale);
$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')
 {
  $oeh=1 if defined $header{$_};
  $oef=1 if defined $footer{$_};
}
for $a ('left','center','right') {

doc/html2ps  view on Meta::CPAN

  if($opt_g) {
    $fc=1;
    $pg1="pgm";
    $pg2="|ppmtopgm";
  } 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/);
  open(SCRATCH,">$scr");
  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-$1 -$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");
      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 (@_) {
    if(s/(^|[^\\])\$(T|N|U|H|A)/$1)join $vars{$2} join(/g) {$_="()$_\join"};
    s/(^|[^\\])\$D\{($S)\}/"$1".POSIX::strftime($+,@now)/eg;
    s/(^|[^\\])\$D/"$1".POSIX::strftime($datefmt,@now)/eg;
    s/(^|[^\\])\\/$1/g;
    s/\(\)join//g;
    s/\(\) ?(\([^)]*\)|\w+) ?join/$1/g;
  }