CAD-Mesh3D

 view release on metacpan or  search on metacpan

lib/CAD/Mesh3D/FormatSTL.pm  view on Meta::CPAN

    # now, detection...
    $mode = sub {
      my $fh = shift;
      seek($fh, 80, 0);
      my $count = eval {
        my $buf; read($fh, $buf, 4) or die;
        unpack('L', $buf);
      };
      $@ and return 'ascii'; # if we hit eof, it can't be binary
      $count or die "detection failed - no facets?";
      my $size = (stat($fh))[7];
      # calculate the expected file size
      my $expect =
        + 80 # header
        +  4 # count
        + $count * (
          + 4 # normal, pt,pt,pt (vectors)
          * 4 # bytes per value
          * 3 # values per vector
          + 2 # the trailing 'short'
        );

lib/CAD/Mesh3D/STL.pm  view on Meta::CPAN

otherwise C<input()> will die.  (In-memory filehandles are not common. See L<open>, search for
"in-memory file", to find a little more about them.  It is not likely you will require such
a situation, but with explicit C<$mode>, they will work.)

=cut

sub inputStl {
    my ($file, $asc_or_bin) = @_;
    my @pass_args = ($file);
    if( !defined($asc_or_bin) || ('' eq $asc_or_bin)) { # automatic
        # automatic won't work on in-memory files, for which stat() will give an "unopened filehandle" warning
        #   unfortunately, perl v5.16 - v5.20 seem to _not_ give that warning.  Check definedness of $size, instead
        #   (which actually simplifies the check, significantly)
        in_memory_check: {
            no warnings 'unopened';         # avoid printing the warning; just looking for the definedness of $size
            my $size = (stat($file))[7];    # on perl v<5.16 and v>5.20, will warn; on all tested perl, will give $size=undef
            croak "\ninputStl($file): ERROR\n",
                        "\tin-memory file handles are not allowed without explicit ASCII or BINARY setting\n",
                        "\tplease rewrite the call with an explicit\n",
                        "\t\tinputStl(\$in_mem_fh, \$asc_or_bin)\n",
                        "\tor\n",
                        "\t\tinput(STL => \$in_mem_fh, \$asc_or_bin)\n",
                        "\twhere \$asc_or_bin is either 'ascii' or 'binary'\n",
                        " "
                unless defined $size;
        }

patch/STL.pm  view on Meta::CPAN

    # now, detection...
    $mode = sub {
      my $fh = shift;
      seek($fh, 80, 0);
      my $count = eval {
        my $buf; read($fh, $buf, 4) or die;
        unpack('L', $buf);
      };
      $@ and return 'ascii'; # if we hit eof, it can't be binary
      $count or die "detection failed - no facets?";
      my $size = (stat($fh))[7];
      # calculate the expected file size
      my $expect =
        + 80 # header
        +  4 # count
        + $count * (
          + 4 # normal, pt,pt,pt (vectors)
          * 4 # bytes per value
          * 3 # values per vector
          + 2 # the trailing 'short'
        );

t/patched/CAD/Format/STL.pm  view on Meta::CPAN

    # now, detection...
    $mode = sub {
      my $fh = shift;
      seek($fh, 80, 0);
      my $count = eval {
        my $buf; read($fh, $buf, 4) or die;
        unpack('L', $buf);
      };
      $@ and return 'ascii'; # if we hit eof, it can't be binary
      $count or die "detection failed - no facets?";
      my $size = (stat($fh))[7];
      # calculate the expected file size
      my $expect =
        + 80 # header
        +  4 # count
        + $count * (
          + 4 # normal, pt,pt,pt (vectors)
          * 4 # bytes per value
          * 3 # values per vector
          + 2 # the trailing 'short'
        );

t/unpatched/CAD/Format/STL.pm  view on Meta::CPAN

    # now, detection...
    $mode = sub {
      my $fh = shift;
      seek($fh, 80, 0);
      my $count = eval {
        my $buf; read($fh, $buf, 4) or die;
        unpack('L', $buf);
      };
      $@ and return 'ascii'; # if we hit eof, it can't be binary
      $count or die "detection failed - no facets?";
      my $size = (stat($fh))[7];
      # calculate the expected file size
      my $expect =
        + 80 # header
        +  4 # count
        + $count * (
          + 4 # normal, pt,pt,pt (vectors)
          * 4 # bytes per value
          * 3 # values per vector
          + 2 # the trailing 'short'
        );