prefs results from the CPAN

prefs

PDF-Reuse

view release on metacpan or search on metacpan

                         cluck
                         croak);

use Compress::Zlib qw(compress inflateInit);

use autouse 'Data::Dumper'   => qw(Dumper);
#use AutoLoader qw(AUTOLOAD);

our $VERSION = '0.43';
our @ISA     = qw(Exporter);
our @EXPORT  = qw(prFile
                  prPage
                  prId
                  prIdType
                  prInitVars
                  prEnd
                  prExtract
                  prForm
                  prImage
                  prAltJpeg
                  prJpeg
                  prDoc
                  prDocForm
                  prFont
                  prFontSize
                  prGraphState
                  prGetLogBuffer
                  prAdd
                  prBar
                  prText
                  prDocDir
                  prLogDir
                  prLog
                  prVers
                  prCid
                  prJs
                  prInit
                  prField
                  prTouchUp
                  prCompress
                  prMbox
                  prBookmark
                  prStrWidth
                  prLink
                  prTTFont
                  prSinglePage);

our ($utfil, $slutNod, $formCont, $imSeq, $duplicateInits, $page, $sidObjNr, $sida,
    $interActive, $NamesSaved, $AARootSaved, $AAPageSaved, $root,
    $AcroFormSaved, $id, $ldir, $checkId, $formNr, $imageNr,
    $filnamn, $interAktivSida, $taInterAkt, $type, $runfil, $checkCs,
    $confuseObj, $compress, $pos, $fontNr, $objNr, $docProxy,
    $defGState, $gSNr, $pattern, $shading, $colorSpace, $totalCount);

our (@kids, @counts, @formBox, @objekt, @parents, @aktuellFont, @skapa,
    @jsfiler, @inits, @bookmarks, @annots);

our ( %old, %oldObject, %resurser, %form, %image, %objRef, %nyaFunk, %fontSource,
     %sidFont, %sidXObject, %sidExtGState, %font, %intAct, %fields, %script,
     %initScript, %sidPattern, %sidShading, %sidColorSpace, %knownToFile,
     %processed, %embedded, %dummy, %behandlad, %unZipped, %links, %prefs);

our $stream  = '';
our $idTyp   = '';
our $ddir    = '';
our $log     = '';

#########################
# Konstanter för objekt
#########################

use constant   oNR        => 0;
use constant   oPOS       => 1;
use constant   oSTREAMP   => 2;
use constant   oKIDS      => 3;
use constant   oFORM      => 4;
use constant   oIMAGENR   => 5;
use constant   oWIDTH     => 6;
use constant   oHEIGHT    => 7;
use constant   oTYPE      => 8;
use constant   oNAME      => 9;

###################################
# Konstanter för formulär
###################################

use constant   fOBJ       => 0;
use constant   fRESOURCE  => 1;
use constant   fBBOX      => 2;
use constant   fIMAGES    => 3;
use constant   fMAIN      => 4;
use constant   fKIDS      => 5;
use constant   fNOKIDS    => 6;
use constant   fID        => 7;
use constant   fVALID     => 8;

####################################
# Konstanter för images
####################################

use constant   imWIDTH     => 0;
use constant   imHEIGHT    => 1;
use constant   imXPOS      => 2;
use constant   imYPOS      => 3;
use constant   imXSCALE    => 4;
use constant   imYSCALE    => 5;
use constant   imIMAGENO   => 6;

#####################################
# Konstanter för interaktiva objekt
#####################################

use constant   iNAMES     => 1;
use constant   iACROFORM  => 2;
use constant   iAAROOT    => 3;
use constant   iANNOTS    => 4;
use constant   iSTARTSIDA => 5;
use constant   iAAPAGE    => 6;

#####################################
# Konstanter för fonter

lib/PDF/Reuse.pm view on Meta::CPAN


our $ws = '\s';#'(?:[ \0\n\r\t\f]|%[^\r\n]*[\r\n])';

our $genLowerX    = 0;
our $genLowerY    = 0;
our $genUpperX    = 595,
our $genUpperY    = 842;
our $genFont      = 'Helvetica';
our $fontSize     = 12;

keys(%resurser)  = 10;

sub prFont
{   my $nyFont = shift;
    my ($intnamn, $extnamn, $objektnr, $oldIntNamn, $oldExtNamn);

    if (! $pos)
    {  errLog("No output file, you have to call prFile first");
    }
    $oldIntNamn = $aktuellFont[foINTNAMN];
    $oldExtNamn = $aktuellFont[foEXTNAMN];
    if ($nyFont)
    {  ($intnamn, $extnamn, $objektnr) = findFont($nyFont);
    }
    else
    {   $intnamn = $aktuellFont[foINTNAMN];
        $extnamn = $aktuellFont[foEXTNAMN];
    }
    if ($runfil)
    {  $log .= "Font~$nyFont\n";
    }
    if (wantarray)
    {  return ($intnamn, $extnamn, $oldIntNamn, $oldExtNamn, \%font);
    }
    else
    {  return $intnamn;
    }
}

sub prFontSize
{   my $fSize = shift || 12;
    my $oldFontSize = $fontSize;
    if ($fSize =~ m'\d+\.?\d*'o)
    { $fontSize = $fSize;
      if ($runfil)
      {  $log .= "FontSize~$fontSize\n";
      }
    }
    if (! $pos)
    {  errLog("No output file, you have to call prFile first");
    }

    return ($fontSize, $oldFontSize);
}

sub prFile
{  if ($pos)
   {  prEnd();
      close UTFIL;
   }
   %prefs = ();
   my $param = shift;
   if (ref($param) eq 'HASH')
   {  $filnamn  = '-';
      for (keys %{$param})
      {   my $key = lc($_);
          if ($key eq 'name')
          {  $filnamn = $param->{$_}; }
          elsif (($key eq 'hidetoolbar')
          ||     ($key eq 'hidemenubar')
          ||     ($key eq 'hidewindowui')
          ||     ($key eq 'fitwindow')
          ||     ($key eq 'centerwindow'))
          {  $prefs{$key} = $param->{$_};
          }
      }
   }
   else
   {  $filnamn  = $param || '-';
      $prefs{hidetoolbar}  = $_[1]  if defined $_[1];
      $prefs{hidemenubar}  = $_[2]  if defined $_[2];
      $prefs{hidewindowui} = $_[3]  if defined $_[3];
      $prefs{fitwindow}    = $_[4]  if defined $_[4];
      $prefs{centerwindow} = $_[5]  if defined $_[5];
   }
   my $kortNamn;
   if ($filnamn ne '-')
   {   my $ri  = rindex($filnamn,'/');
       if ($ri > 0)
       {  $kortNamn = substr($filnamn, ($ri + 1));
          $utfil = $ddir ? $ddir . $kortNamn : $filnamn;
       }
       else
       {  $utfil = $ddir ? $ddir . $filnamn : $filnamn;
       }
       $ri = rindex($utfil,'/');
       if ($ri > 0)
       {   my $dirdel = substr($utfil,0,$ri);
           if (! -e $dirdel)
           {  mkdir $dirdel || errLog("Couldn't create dir $dirdel, $!");
           }
       }
       else
       {  $ri = rindex($utfil,'\\');
          if ($ri > 0)
          {   my $dirdel = substr($utfil,0,$ri);
              if (! -e $dirdel)
              {  mkdir $dirdel || errLog("Couldn't create dir $dirdel, $!");
              }
          }
       }
   }
   else
   {   $utfil = $filnamn;
   }

   my $utfil_ref = ref $utfil;
   { no warnings; untie *UTFIL; }  # Clear any previous tie (e.g., from IO::String)
   if ($utfil_ref and ($utfil_ref eq 'Apache2::RequestRec') or
                      ($utfil_ref eq 'Apache::RequestRec') ) # mod_perl 2
   { tie *UTFIL, $utfil;
   }
   elsif (IS_MODPERL && $utfil eq '-')     # mod_perl 1
   { tie *UTFIL, 'Apache';
   }
   elsif ($utfil_ref and $utfil_ref eq 'IO::String')
   { tie *UTFIL, $utfil;
   }
   else
   { open (UTFIL, ">$utfil") || errLog("Couldn't open file $utfil, $!");
   }
   binmode UTFIL;
   my $utrad = "\%PDF-1.4\n\%\â\ã\Ï\Ó\n";

   $pos   = syswrite UTFIL, $utrad;

   if (defined $ldir)
   {   if ($utfil eq '-')
       {   $kortNamn = 'stdout';
       }
       if ($kortNamn)
       {  $runfil = $ldir . $kortNamn  . '.dat';
       }
       else
       {  $runfil = $ldir . $filnamn  . '.dat';
       }
       open (RUNFIL, ">>$runfil") || errLog("Couldn't open logfile $runfil, $!");
       $log .= "Vers~$VERSION\n";
   }


   @parents     = ();
   @kids        = ();
   @counts      = ();
   @objekt      = ();
   $objNr       = 2; # Reserverat objekt 1 för root och 2 för initial sidnod
   $parents[0]  = 2;
   $page        = 0;
   $formNr      = 0;
   $imageNr     = 0;
   $fontNr      = 0;
   $gSNr        = 0;
   $pattern     = 0;
   $shading     = 0;
   $colorSpace  = 0;
   $sida        = 0;
   %font        = ();
   %resurser    = ();
   %fields      = ();
   @jsfiler     = ();
   @inits       = ();
   %nyaFunk     = ();
   %objRef      = ();
   %knownToFile = ();
   @aktuellFont = ();
   %old         = ();
   %behandlad   = ();
   @bookmarks   = ();
   %links       = ();
   undef $defGState;
   undef $interActive;
   undef $NamesSaved;
   undef $AARootSaved;
   undef $AcroFormSaved;
   $checkId    = '';
   undef $duplicateInits;
   undef $confuseObj;
   $fontSize  = 12;
   $genLowerX = 0;
   $genLowerY = 0;
   $genUpperX = 595,
   $genUpperY = 842;

   prPage(1);
   $stream = ' ';
   if ($runfil)
   {  $filnamn = prep($filnamn);
      $log .= "File~$filnamn";
      $log .= (exists $prefs{hidetoolbar}) ? "~$prefs{hidetoolbar}" : '~';
      $log .= (exists $prefs{hidemenubar}) ? "~$prefs{hidemenubar}" : '~';
      $log .= (exists $prefs{hidewindowui}) ? "~$prefs{hidewindowui}" : '~';
      $log .= (exists $prefs{fitwindow}) ? "~$prefs{fitwindow}" : '~';
      $log .= (exists $prefs{centerwindow}) ? "~$prefs{centerwindow}" : "~\n";
   }
   1;
}


sub prPage
{  my $noLogg = shift;
   if ((defined $stream) && (length($stream) > 0))
   { skrivSida();
   }

   $page++;
   $objNr++;
   $sidObjNr = $objNr;

   #
   # Resurserna nollställs
   #

   %sidXObject    = ();
   %sidExtGState  = ();
   %sidFont       = ();
   %sidPattern    = ();
   %sidShading    = ();
   %sidColorSpace = ();
   @annots        = ();

   undef $interAktivSida;
   undef $checkCs;
   if (($runfil) && (! $noLogg))
   {  $log .= "Page~\n";
       print RUNFIL $log;
       $log = '';
   }
   if (! $pos)
   {  errLog("No output file, you have to call prFile first");
   }
   1;

}

sub prText
{ my $xPos  = shift;
  my $yPos  = shift;
  my $TxT   = shift;
  my $align = shift || 'left';
  my $rot   = shift || '0';

  my $width = 0;
  my $x_align_offset = 0;

  if (! defined $TxT)
  {  $TxT = '';
  }

  if (($xPos !~ m'\-?[\d\.]+'o) || (! defined $xPos))
  { errLog("Illegal x-position for text: $xPos");
  }
  if (($yPos !~ m'\-?[\d\.]+'o) || (! defined $yPos))
  { errLog("Illegal y-position for text: $yPos");

lib/PDF/Reuse.pm view on Meta::CPAN

    $sida++;
    $counts[0]++;
    if ($counts[0] > 9)
    {  ordnaNoder(8); }
}


sub prEnd
{   if (! $pos)
    {  return;
    }
    if ($stream)
    { skrivSida(); }
    skrivUtNoder();

    if($docProxy)
    {  $docProxy->write_objects;
       # Release Font::TTF data and TTFont0 objects now that they are written
       for my $obj (values %{ $docProxy->{' objcache'} })
       {  if ($obj->isa('Text::PDF::TTFont0'))
          {  if (my $font = delete $obj->{' font'})
             {  $font->release();
             }
             $obj->release();
          }
       }
       undef $docProxy;             # Break circular refs
    }

    ###################
    # Skriv root
    ###################

    if (! defined $objekt[$objNr])
    {  $objNr--;                   # reserverat sidobjektnr utnyttjades aldrig
    }

    my $utrad = "1 0 obj<</Type/Catalog/Pages $slutNod 0 R";
    if (defined $NamesSaved)
    {  $utrad .= "\/Names $NamesSaved 0 R\n";
    }
    elsif ((scalar %fields) || (scalar @jsfiler))
    {  $utrad .= "\/Names " . behandlaNames() . " 0 R\n";
    }
    if (defined $AARootSaved)
    {  $utrad .= "/AA $AARootSaved\n";
    }
    if ((scalar @inits) || (scalar %fields))
    {  my $nyttANr = skrivKedja();
       $utrad .= "/OpenAction $nyttANr 0 R";
    }

    if (defined $AcroFormSaved)
    {  $utrad .= "/AcroForm $AcroFormSaved\n";
    }

    if (scalar @bookmarks)
    {  my $outLine = ordnaBookmarks();
       $utrad .= "/Outlines $outLine 0 R/PageMode /UseOutlines\n";
    }
    if (scalar %prefs)
    {   $utrad .= '/ViewerPreferences << ';
        if (exists $prefs{hidetoolbar})
        {  $utrad .= ($prefs{hidetoolbar}) ? '/HideToolbar true'
                                           : '/HideToolbar false';
        }
        if (exists $prefs{hidemenubar})
        {  $utrad .= ($prefs{hidemenubar}) ? '/HideMenubar true'
                                           : '/HideMenubar false';
        }
        if (exists $prefs{hidewindowui})
        {  $utrad .= ($prefs{hidewindowui}) ? '/HideWindowUI true'
                                            : '/HideWindowUI false';
        }
        if (exists $prefs{fitwindow})
        {  $utrad .= ($prefs{fitwindow}) ? '/FitWindow true'
                                         : '/FitWindow false';
        }
        if (exists $prefs{centerwindow})
        {  $utrad .= ($prefs{centerwindow}) ? '/CenterWindow true'
                                            : '/CenterWindow false';
        }
        $utrad .= '>> ';
    }

    $utrad .= ">>endobj\n";

    $objekt[1] = $pos;
    $pos += syswrite UTFIL, $utrad;
    my $antal = $#objekt;
    my $startxref = $pos;
    my $xrefAntal = $antal + 1;
    $pos += syswrite UTFIL, "xref\n";
    $pos += syswrite UTFIL, "0 $xrefAntal\n";
    $pos += syswrite UTFIL, "0000000000 65535 f \n";

    for (my $i = 1; $i <= $antal; $i++)
    {  $utrad = sprintf "%.10d 00000 n \n", $objekt[$i] // 0;
       $pos += syswrite UTFIL, $utrad;
    }

    $utrad  = "trailer\n<<\n/Size $xrefAntal\n/Root 1 0 R\n";
    if ($idTyp ne 'None')
    {  my ($id1, $id2) = definieraId();
       $utrad .= "/ID [<$id1><$id2>]\n";
       $log  .= "IdType~rep\n";
       $log  .= "Id~$id1\n";
    }
    $utrad .= ">>\nstartxref\n$startxref\n";
    $pos += syswrite UTFIL, $utrad;
    $pos += syswrite UTFIL, "%%EOF\n";
    close UTFIL;
    { no warnings; untie *UTFIL; }

    if ($runfil)
    {   if ($log)
        { print RUNFIL $log;
        }
        close RUNFIL;
    }
    $log    = '';
    $runfil = '';
    $pos    = 0;
    1;
}

sub ordnaNoder
{  my $antBarn = shift;
   my $i       = 0;
   my $j       = 1;
   my $vektor;

   while  ($antBarn < $#{$kids[$i]})
   {  #
      # Skriv ut aktuell förälder
      # flytta till nästa nivå
      #
      $vektor = '[';

      for (@{$kids[$i]})

( run in 1.605 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )