xref: /openbsd-src/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm (revision ac9b4aacc1da35008afea06a5d23c2f2dea9b93e) 
1package IO::Compress::Base::Common;
2
3use strict ;
4use warnings;
5use bytes;
6
7use Carp;
8use Scalar::Util qw(blessed readonly);
9use File::GlobMapper;
10
11require Exporter;
12our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
13@ISA = qw(Exporter);
14$VERSION = '2.024';
15
16@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput
17              isaFileGlobString cleanFileGlobString oneTarget
18              setBinModeInput setBinModeOutput
19              ckInOutParams
20              createSelfTiedObject
21              getEncoding
22
23              WANT_CODE
24              WANT_EXT
25              WANT_UNDEF
26              WANT_HASH
27
28              STATUS_OK
29              STATUS_ENDSTREAM
30              STATUS_EOF
31              STATUS_ERROR
32          );
33
34%EXPORT_TAGS = ( Status => [qw( STATUS_OK
35                                 STATUS_ENDSTREAM
36                                 STATUS_EOF
37                                 STATUS_ERROR
38                           )]);
39
40
41use constant STATUS_OK        => 0;
42use constant STATUS_ENDSTREAM => 1;
43use constant STATUS_EOF       => 2;
44use constant STATUS_ERROR     => -1;
45
46sub hasEncode()
47{
48    if (! defined $HAS_ENCODE) {
49        eval
50        {
51            require Encode;
52            Encode->import();
53        };
54
55        $HAS_ENCODE = $@ ? 0 : 1 ;
56    }
57
58    return $HAS_ENCODE;
59}
60
61sub getEncoding($$$)
62{
63    my $obj = shift;
64    my $class = shift ;
65    my $want_encoding = shift ;
66
67    $obj->croakError("$class: Encode module needed to use -Encode")
68        if ! hasEncode();
69
70    my $encoding = Encode::find_encoding($want_encoding);
71
72    $obj->croakError("$class: Encoding '$want_encoding' is not available")
73       if ! $encoding;
74
75    return $encoding;
76}
77
78our ($needBinmode);
79$needBinmode = ($^O eq 'MSWin32' ||
80                    ($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} '))
81                    ? 1 : 1 ;
82
83sub setBinModeInput($)
84{
85    my $handle = shift ;
86
87    binmode $handle
88        if  $needBinmode;
89}
90
91sub setBinModeOutput($)
92{
93    my $handle = shift ;
94
95    binmode $handle
96        if  $needBinmode;
97}
98
99sub isaFilehandle($)
100{
101    use utf8; # Pragma needed to keep Perl 5.6.0 happy
102    return (defined $_[0] and
103             (UNIVERSAL::isa($_[0],'GLOB') or
104              UNIVERSAL::isa($_[0],'IO::Handle') or
105              UNIVERSAL::isa(\$_[0],'GLOB'))
106          )
107}
108
109sub isaFilename($)
110{
111    return (defined $_[0] and
112           ! ref $_[0]    and
113           UNIVERSAL::isa(\$_[0], 'SCALAR'));
114}
115
116sub isaFileGlobString
117{
118    return defined $_[0] && $_[0] =~ /^<.*>$/;
119}
120
121sub cleanFileGlobString
122{
123    my $string = shift ;
124
125    $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;
126
127    return $string;
128}
129
130use constant WANT_CODE  => 1 ;
131use constant WANT_EXT   => 2 ;
132use constant WANT_UNDEF => 4 ;
133#use constant WANT_HASH  => 8 ;
134use constant WANT_HASH  => 0 ;
135
136sub whatIsInput($;$)
137{
138    my $got = whatIs(@_);
139
140    if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
141    {
142        #use IO::File;
143        $got = 'handle';
144        $_[0] = *STDIN;
145        #$_[0] = new IO::File("<-");
146    }
147
148    return $got;
149}
150
151sub whatIsOutput($;$)
152{
153    my $got = whatIs(@_);
154
155    if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
156    {
157        $got = 'handle';
158        $_[0] = *STDOUT;
159        #$_[0] = new IO::File(">-");
160    }
161
162    return $got;
163}
164
165sub whatIs ($;$)
166{
167    return 'handle' if isaFilehandle($_[0]);
168
169    my $wantCode = defined $_[1] && $_[1] & WANT_CODE ;
170    my $extended = defined $_[1] && $_[1] & WANT_EXT ;
171    my $undef    = defined $_[1] && $_[1] & WANT_UNDEF ;
172    my $hash     = defined $_[1] && $_[1] & WANT_HASH ;
173
174    return 'undef'  if ! defined $_[0] && $undef ;
175
176    if (ref $_[0]) {
177        return ''       if blessed($_[0]); # is an object
178        #return ''       if UNIVERSAL::isa($_[0], 'UNIVERSAL'); # is an object
179        return 'buffer' if UNIVERSAL::isa($_[0], 'SCALAR');
180        return 'array'  if UNIVERSAL::isa($_[0], 'ARRAY')  && $extended ;
181        return 'hash'   if UNIVERSAL::isa($_[0], 'HASH')   && $hash ;
182        return 'code'   if UNIVERSAL::isa($_[0], 'CODE')   && $wantCode ;
183        return '';
184    }
185
186    return 'fileglob' if $extended && isaFileGlobString($_[0]);
187    return 'filename';
188}
189
190sub oneTarget
191{
192    return $_[0] =~ /^(code|handle|buffer|filename)$/;
193}
194
195sub IO::Compress::Base::Validator::new
196{
197    my $class = shift ;
198
199    my $Class = shift ;
200    my $error_ref = shift ;
201    my $reportClass = shift ;
202
203    my %data = (Class       => $Class,
204                Error       => $error_ref,
205                reportClass => $reportClass,
206               ) ;
207
208    my $obj = bless \%data, $class ;
209
210    local $Carp::CarpLevel = 1;
211
212    my $inType    = $data{inType}    = whatIsInput($_[0], WANT_EXT|WANT_HASH);
213    my $outType   = $data{outType}   = whatIsOutput($_[1], WANT_EXT|WANT_HASH);
214
215    my $oneInput  = $data{oneInput}  = oneTarget($inType);
216    my $oneOutput = $data{oneOutput} = oneTarget($outType);
217
218    if (! $inType)
219    {
220        $obj->croakError("$reportClass: illegal input parameter") ;
221        #return undef ;
222    }
223
224#    if ($inType eq 'hash')
225#    {
226#        $obj->{Hash} = 1 ;
227#        $obj->{oneInput} = 1 ;
228#        return $obj->validateHash($_[0]);
229#    }
230
231    if (! $outType)
232    {
233        $obj->croakError("$reportClass: illegal output parameter") ;
234        #return undef ;
235    }
236
237
238    if ($inType ne 'fileglob' && $outType eq 'fileglob')
239    {
240        $obj->croakError("Need input fileglob for outout fileglob");
241    }
242
243#    if ($inType ne 'fileglob' && $outType eq 'hash' && $inType ne 'filename' )
244#    {
245#        $obj->croakError("input must ne filename or fileglob when output is a hash");
246#    }
247
248    if ($inType eq 'fileglob' && $outType eq 'fileglob')
249    {
250        $data{GlobMap} = 1 ;
251        $data{inType} = $data{outType} = 'filename';
252        my $mapper = new File::GlobMapper($_[0], $_[1]);
253        if ( ! $mapper )
254        {
255            return $obj->saveErrorString($File::GlobMapper::Error) ;
256        }
257        $data{Pairs} = $mapper->getFileMap();
258
259        return $obj;
260    }
261
262    $obj->croakError("$reportClass: input and output $inType are identical")
263        if $inType eq $outType && $_[0] eq $_[1] && $_[0] ne '-' ;
264
265    if ($inType eq 'fileglob') # && $outType ne 'fileglob'
266    {
267        my $glob = cleanFileGlobString($_[0]);
268        my @inputs = glob($glob);
269
270        if (@inputs == 0)
271        {
272            # TODO -- legal or die?
273            die "globmap matched zero file -- legal or die???" ;
274        }
275        elsif (@inputs == 1)
276        {
277            $obj->validateInputFilenames($inputs[0])
278                or return undef;
279            $_[0] = $inputs[0]  ;
280            $data{inType} = 'filename' ;
281            $data{oneInput} = 1;
282        }
283        else
284        {
285            $obj->validateInputFilenames(@inputs)
286                or return undef;
287            $_[0] = [ @inputs ] ;
288            $data{inType} = 'filenames' ;
289        }
290    }
291    elsif ($inType eq 'filename')
292    {
293        $obj->validateInputFilenames($_[0])
294            or return undef;
295    }
296    elsif ($inType eq 'array')
297    {
298        $data{inType} = 'filenames' ;
299        $obj->validateInputArray($_[0])
300            or return undef ;
301    }
302
303    return $obj->saveErrorString("$reportClass: output buffer is read-only")
304        if $outType eq 'buffer' && readonly(${ $_[1] });
305
306    if ($outType eq 'filename' )
307    {
308        $obj->croakError("$reportClass: output filename is undef or null string")
309            if ! defined $_[1] || $_[1] eq ''  ;
310
311        if (-e $_[1])
312        {
313            if (-d _ )
314            {
315                return $obj->saveErrorString("output file '$_[1]' is a directory");
316            }
317        }
318    }
319
320    return $obj ;
321}
322
323sub IO::Compress::Base::Validator::saveErrorString
324{
325    my $self   = shift ;
326    ${ $self->{Error} } = shift ;
327    return undef;
328
329}
330
331sub IO::Compress::Base::Validator::croakError
332{
333    my $self   = shift ;
334    $self->saveErrorString($_[0]);
335    croak $_[0];
336}
337
338
339
340sub IO::Compress::Base::Validator::validateInputFilenames
341{
342    my $self = shift ;
343
344    foreach my $filename (@_)
345    {
346        $self->croakError("$self->{reportClass}: input filename is undef or null string")
347            if ! defined $filename || $filename eq ''  ;
348
349        next if $filename eq '-';
350
351        if (! -e $filename )
352        {
353            return $self->saveErrorString("input file '$filename' does not exist");
354        }
355
356        if (-d _ )
357        {
358            return $self->saveErrorString("input file '$filename' is a directory");
359        }
360
361        if (! -r _ )
362        {
363            return $self->saveErrorString("cannot open file '$filename': $!");
364        }
365    }
366
367    return 1 ;
368}
369
370sub IO::Compress::Base::Validator::validateInputArray
371{
372    my $self = shift ;
373
374    if ( @{ $_[0] } == 0 )
375    {
376        return $self->saveErrorString("empty array reference") ;
377    }
378
379    foreach my $element ( @{ $_[0] } )
380    {
381        my $inType  = whatIsInput($element);
382
383        if (! $inType)
384        {
385            $self->croakError("unknown input parameter") ;
386        }
387        elsif($inType eq 'filename')
388        {
389            $self->validateInputFilenames($element)
390                or return undef ;
391        }
392        else
393        {
394            $self->croakError("not a filename") ;
395        }
396    }
397
398    return 1 ;
399}
400
401#sub IO::Compress::Base::Validator::validateHash
402#{
403#    my $self = shift ;
404#    my $href = shift ;
405#
406#    while (my($k, $v) = each %$href)
407#    {
408#        my $ktype = whatIsInput($k);
409#        my $vtype = whatIsOutput($v, WANT_EXT|WANT_UNDEF) ;
410#
411#        if ($ktype ne 'filename')
412#        {
413#            return $self->saveErrorString("hash key not filename") ;
414#        }
415#
416#        my %valid = map { $_ => 1 } qw(filename buffer array undef handle) ;
417#        if (! $valid{$vtype})
418#        {
419#            return $self->saveErrorString("hash value not ok") ;
420#        }
421#    }
422#
423#    return $self ;
424#}
425
426sub createSelfTiedObject
427{
428    my $class = shift || (caller)[0] ;
429    my $error_ref = shift ;
430
431    my $obj = bless Symbol::gensym(), ref($class) || $class;
432    tie *$obj, $obj if $] >= 5.005;
433    *$obj->{Closed} = 1 ;
434    $$error_ref = '';
435    *$obj->{Error} = $error_ref ;
436    my $errno = 0 ;
437    *$obj->{ErrorNo} = \$errno ;
438
439    return $obj;
440}
441
442
443
444#package Parse::Parameters ;
445#
446#
447#require Exporter;
448#our ($VERSION, @ISA, @EXPORT);
449#$VERSION = '2.000_08';
450#@ISA = qw(Exporter);
451
452$EXPORT_TAGS{Parse} = [qw( ParseParameters
453                           Parse_any Parse_unsigned Parse_signed
454                           Parse_boolean Parse_custom Parse_string
455                           Parse_multiple Parse_writable_scalar
456                         )
457                      ];
458
459push @EXPORT, @{ $EXPORT_TAGS{Parse} } ;
460
461use constant Parse_any      => 0x01;
462use constant Parse_unsigned => 0x02;
463use constant Parse_signed   => 0x04;
464use constant Parse_boolean  => 0x08;
465use constant Parse_string   => 0x10;
466use constant Parse_custom   => 0x12;
467
468#use constant Parse_store_ref        => 0x100 ;
469use constant Parse_multiple         => 0x100 ;
470use constant Parse_writable         => 0x200 ;
471use constant Parse_writable_scalar  => 0x400 | Parse_writable ;
472
473use constant OFF_PARSED     => 0 ;
474use constant OFF_TYPE       => 1 ;
475use constant OFF_DEFAULT    => 2 ;
476use constant OFF_FIXED      => 3 ;
477use constant OFF_FIRST_ONLY => 4 ;
478use constant OFF_STICKY     => 5 ;
479
480
481
482sub ParseParameters
483{
484    my $level = shift || 0 ;
485
486    my $sub = (caller($level + 1))[3] ;
487    local $Carp::CarpLevel = 1 ;
488
489    return $_[1]
490        if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters");
491
492    my $p = new IO::Compress::Base::Parameters() ;
493    $p->parse(@_)
494        or croak "$sub: $p->{Error}" ;
495
496    return $p;
497}
498
499#package IO::Compress::Base::Parameters;
500
501use strict;
502use warnings;
503use Carp;
504
505sub IO::Compress::Base::Parameters::new
506{
507    my $class = shift ;
508
509    my $obj = { Error => '',
510                Got   => {},
511              } ;
512
513    #return bless $obj, ref($class) || $class || __PACKAGE__ ;
514    return bless $obj, 'IO::Compress::Base::Parameters' ;
515}
516
517sub IO::Compress::Base::Parameters::setError
518{
519    my $self = shift ;
520    my $error = shift ;
521    my $retval = @_ ? shift : undef ;
522
523    $self->{Error} = $error ;
524    return $retval;
525}
526
527#sub getError
528#{
529#    my $self = shift ;
530#    return $self->{Error} ;
531#}
532
533sub IO::Compress::Base::Parameters::parse
534{
535    my $self = shift ;
536
537    my $default = shift ;
538
539    my $got = $self->{Got} ;
540    my $firstTime = keys %{ $got } == 0 ;
541    my $other;
542
543    my (@Bad) ;
544    my @entered = () ;
545
546    # Allow the options to be passed as a hash reference or
547    # as the complete hash.
548    if (@_ == 0) {
549        @entered = () ;
550    }
551    elsif (@_ == 1) {
552        my $href = $_[0] ;
553
554        return $self->setError("Expected even number of parameters, got 1")
555            if ! defined $href or ! ref $href or ref $href ne "HASH" ;
556
557        foreach my $key (keys %$href) {
558            push @entered, $key ;
559            push @entered, \$href->{$key} ;
560        }
561    }
562    else {
563        my $count = @_;
564        return $self->setError("Expected even number of parameters, got $count")
565            if $count % 2 != 0 ;
566
567        for my $i (0.. $count / 2 - 1) {
568            if ($_[2 * $i] eq '__xxx__') {
569                $other = $_[2 * $i + 1] ;
570            }
571            else {
572                push @entered, $_[2 * $i] ;
573                push @entered, \$_[2 * $i + 1] ;
574            }
575        }
576    }
577
578
579    while (my ($key, $v) = each %$default)
580    {
581        croak "need 4 params [@$v]"
582            if @$v != 4 ;
583
584        my ($first_only, $sticky, $type, $value) = @$v ;
585        my $x ;
586        $self->_checkType($key, \$value, $type, 0, \$x)
587            or return undef ;
588
589        $key = lc $key;
590
591        if ($firstTime || ! $sticky) {
592            $x = []
593                if $type & Parse_multiple;
594
595            $got->{$key} = [0, $type, $value, $x, $first_only, $sticky] ;
596        }
597
598        $got->{$key}[OFF_PARSED] = 0 ;
599    }
600
601    my %parsed = ();
602
603    if ($other)
604    {
605        for my $key (keys %$default)
606        {
607            my $canonkey = lc $key;
608            if ($other->parsed($canonkey))
609            {
610                my $value = $other->value($canonkey);
611#print "SET '$canonkey' to $value [$$value]\n";
612                ++ $parsed{$canonkey};
613                $got->{$canonkey}[OFF_PARSED]  = 1;
614                $got->{$canonkey}[OFF_DEFAULT] = $value;
615                $got->{$canonkey}[OFF_FIXED]   = $value;
616            }
617        }
618    }
619
620    for my $i (0.. @entered / 2 - 1) {
621        my $key = $entered[2* $i] ;
622        my $value = $entered[2* $i+1] ;
623
624        #print "Key [$key] Value [$value]" ;
625        #print defined $$value ? "[$$value]\n" : "[undef]\n";
626
627        $key =~ s/^-// ;
628        my $canonkey = lc $key;
629
630        if ($got->{$canonkey} && ($firstTime ||
631                                  ! $got->{$canonkey}[OFF_FIRST_ONLY]  ))
632        {
633            my $type = $got->{$canonkey}[OFF_TYPE] ;
634            my $parsed = $parsed{$canonkey};
635            ++ $parsed{$canonkey};
636
637            return $self->setError("Muliple instances of '$key' found")
638                if $parsed && $type & Parse_multiple == 0 ;
639
640            my $s ;
641            $self->_checkType($key, $value, $type, 1, \$s)
642                or return undef ;
643
644            $value = $$value ;
645            if ($type & Parse_multiple) {
646                $got->{$canonkey}[OFF_PARSED] = 1;
647                push @{ $got->{$canonkey}[OFF_FIXED] }, $s ;
648            }
649            else {
650                $got->{$canonkey} = [1, $type, $value, $s] ;
651            }
652        }
653        else
654          { push (@Bad, $key) }
655    }
656
657    if (@Bad) {
658        my ($bad) = join(", ", @Bad) ;
659        return $self->setError("unknown key value(s) $bad") ;
660    }
661
662    return 1;
663}
664
665sub IO::Compress::Base::Parameters::_checkType
666{
667    my $self = shift ;
668
669    my $key   = shift ;
670    my $value = shift ;
671    my $type  = shift ;
672    my $validate  = shift ;
673    my $output  = shift;
674
675    #local $Carp::CarpLevel = $level ;
676    #print "PARSE $type $key $value $validate $sub\n" ;
677
678    if ($type & Parse_writable_scalar)
679    {
680        return $self->setError("Parameter '$key' not writable")
681            if $validate &&  readonly $$value ;
682
683        if (ref $$value)
684        {
685            return $self->setError("Parameter '$key' not a scalar reference")
686                if $validate &&  ref $$value ne 'SCALAR' ;
687
688            $$output = $$value ;
689        }
690        else
691        {
692            return $self->setError("Parameter '$key' not a scalar")
693                if $validate &&  ref $value ne 'SCALAR' ;
694
695            $$output = $value ;
696        }
697
698        return 1;
699    }
700
701#    if ($type & Parse_store_ref)
702#    {
703#        #$value = $$value
704#        #    if ref ${ $value } ;
705#
706#        $$output = $value ;
707#        return 1;
708#    }
709
710    $value = $$value ;
711
712    if ($type & Parse_any)
713    {
714        $$output = $value ;
715        return 1;
716    }
717    elsif ($type & Parse_unsigned)
718    {
719        return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'")
720            if $validate && ! defined $value ;
721        return $self->setError("Parameter '$key' must be an unsigned int, got '$value'")
722            if $validate && $value !~ /^\d+$/;
723
724        $$output = defined $value ? $value : 0 ;
725        return 1;
726    }
727    elsif ($type & Parse_signed)
728    {
729        return $self->setError("Parameter '$key' must be a signed int, got 'undef'")
730            if $validate && ! defined $value ;
731        return $self->setError("Parameter '$key' must be a signed int, got '$value'")
732            if $validate && $value !~ /^-?\d+$/;
733
734        $$output = defined $value ? $value : 0 ;
735        return 1 ;
736    }
737    elsif ($type & Parse_boolean)
738    {
739        return $self->setError("Parameter '$key' must be an int, got '$value'")
740            if $validate && defined $value && $value !~ /^\d*$/;
741        $$output =  defined $value ? $value != 0 : 0 ;
742        return 1;
743    }
744    elsif ($type & Parse_string)
745    {
746        $$output = defined $value ? $value : "" ;
747        return 1;
748    }
749
750    $$output = $value ;
751    return 1;
752}
753
754
755
756sub IO::Compress::Base::Parameters::parsed
757{
758    my $self = shift ;
759    my $name = shift ;
760
761    return $self->{Got}{lc $name}[OFF_PARSED] ;
762}
763
764sub IO::Compress::Base::Parameters::value
765{
766    my $self = shift ;
767    my $name = shift ;
768
769    if (@_)
770    {
771        $self->{Got}{lc $name}[OFF_PARSED]  = 1;
772        $self->{Got}{lc $name}[OFF_DEFAULT] = $_[0] ;
773        $self->{Got}{lc $name}[OFF_FIXED]   = $_[0] ;
774    }
775
776    return $self->{Got}{lc $name}[OFF_FIXED] ;
777}
778
779sub IO::Compress::Base::Parameters::valueOrDefault
780{
781    my $self = shift ;
782    my $name = shift ;
783    my $default = shift ;
784
785    my $value = $self->{Got}{lc $name}[OFF_DEFAULT] ;
786
787    return $value if defined $value ;
788    return $default ;
789}
790
791sub IO::Compress::Base::Parameters::wantValue
792{
793    my $self = shift ;
794    my $name = shift ;
795
796    return defined $self->{Got}{lc $name}[OFF_DEFAULT] ;
797
798}
799
800sub IO::Compress::Base::Parameters::clone
801{
802    my $self = shift ;
803    my $obj = { };
804    my %got ;
805
806    while (my ($k, $v) = each %{ $self->{Got} }) {
807        $got{$k} = [ @$v ];
808    }
809
810    $obj->{Error} = $self->{Error};
811    $obj->{Got} = \%got ;
812
813    return bless $obj, 'IO::Compress::Base::Parameters' ;
814}
815
816package U64;
817
818use constant MAX32 => 0xFFFFFFFF ;
819use constant HI_1 => MAX32 + 1 ;
820use constant LOW   => 0 ;
821use constant HIGH  => 1;
822
823sub new
824{
825    my $class = shift ;
826
827    my $high = 0 ;
828    my $low  = 0 ;
829
830    if (@_ == 2) {
831        $high = shift ;
832        $low  = shift ;
833    }
834    elsif (@_ == 1) {
835        $low  = shift ;
836    }
837
838    bless [$low, $high], $class;
839}
840
841sub newUnpack_V64
842{
843    my $string = shift;
844
845    my ($low, $hi) = unpack "V V", $string ;
846    bless [ $low, $hi ], "U64";
847}
848
849sub newUnpack_V32
850{
851    my $string = shift;
852
853    my $low = unpack "V", $string ;
854    bless [ $low, 0 ], "U64";
855}
856
857sub reset
858{
859    my $self = shift;
860    $self->[HIGH] = $self->[LOW] = 0;
861}
862
863sub clone
864{
865    my $self = shift;
866    bless [ @$self ], ref $self ;
867}
868
869sub getHigh
870{
871    my $self = shift;
872    return $self->[HIGH];
873}
874
875sub getLow
876{
877    my $self = shift;
878    return $self->[LOW];
879}
880
881sub get32bit
882{
883    my $self = shift;
884    return $self->[LOW];
885}
886
887sub get64bit
888{
889    my $self = shift;
890    # Not using << here because the result will still be
891    # a 32-bit value on systems where int size is 32-bits
892    return $self->[HIGH] * HI_1 + $self->[LOW];
893}
894
895sub add
896{
897    my $self = shift;
898    my $value = shift;
899
900    if (ref $value eq 'U64') {
901        $self->[HIGH] += $value->[HIGH] ;
902        $value = $value->[LOW];
903    }
904
905    my $available = MAX32 - $self->[LOW] ;
906
907    if ($value > $available) {
908       ++ $self->[HIGH] ;
909       $self->[LOW] = $value - $available - 1;
910    }
911    else {
912       $self->[LOW] += $value ;
913    }
914
915}
916
917sub equal
918{
919    my $self = shift;
920    my $other = shift;
921
922    return $self->[LOW]  == $other->[LOW] &&
923           $self->[HIGH] == $other->[HIGH] ;
924}
925
926sub is64bit
927{
928    my $self = shift;
929    return $self->[HIGH] > 0 ;
930}
931
932sub getPacked_V64
933{
934    my $self = shift;
935
936    return pack "V V", @$self ;
937}
938
939sub getPacked_V32
940{
941    my $self = shift;
942
943    return pack "V", $self->[LOW] ;
944}
945
946sub pack_V64
947{
948    my $low  = shift;
949
950    return pack "V V", $low, 0;
951}
952
953
954package IO::Compress::Base::Common;
955
9561;
957