File Coverage

lib/Encoding/BER/Dumper.pm
Criterion Covered Total %
statement 35 35 100.0
branch 5 6 83.3
condition n/a
subroutine 8 8 100.0
pod 0 3 0.0
total 48 52 92.3


line stmt bran cond sub pod time code
1             # -*- perl -*-
2              
3             # Copyright (c) 2007 by Jeff Weisberg
4             # Author: Jeff Weisberg
5             # Created: 2007-Feb-04 16:43 (EST)
6             # Function: dump perl data to/from ber
7             #
8             # $Id: Dumper.pm,v 1.5 2007/03/06 02:50:10 jaw Exp $
9              
10             package Encoding::BER::Dumper;
11 1     1   2259 use Encoding::BER;
  1         2  
  1         6  
12 1     1   4 use vars qw($VERSION);
  1         2  
  1         43  
13             $VERSION = '1.00';
14 1     1   4 use strict;
  1         1  
  1         296  
15              
16             sub pl2ber {
17 1     1 0 23 my $pl = shift;
18              
19 1         7 my $enc = Encoding::BER->new(acanonical => 1);
20 1         5 $enc->encode($pl);
21             }
22              
23             sub ber2pl {
24 1     1 0 20 my $ber = shift;
25            
26 1         3 my $dec = Encoding::BER->new( );
27 1         5 $dec->add_tag('application', 'constructed', 'berdump_hash', 3);
28 1         4 decanon($dec->decode($ber));
29             }
30              
31             sub decanon {
32 9     9 0 11 my $n = shift;
33 9         16 my $v = $n->{value};
34              
35 9 100       33 return $v unless ref $v;
36              
37 2         3 my @v;
38 2         5 for my $r (@$v){
39 8         21 push @v, decanon($r);
40             }
41              
42 2 100       6 if( $n->{type}[2] eq 'berdump_hash' ){
43 1         4 return { @v };
44             }else{
45 1         8 return \@v;
46             }
47             }
48              
49             sub import {
50 1     1   8 my $pkg = shift;
51 1         2 my $caller = caller;
52              
53 1         2 for my $f ('pl2ber', 'ber2pl'){
54 1     1   6 no strict;
  1         1  
  1         80  
55 2         13 my $fnc = $pkg->can($f);
56 2 50       7 next unless $fnc;
57 2         2 *{$caller . '::' . $f} = $fnc;
  2         28  
58             }
59             }
60              
61             =head1 NAME
62              
63             Encoding::BER::Dumper - Perl module for dumping Perl objects from/to BER
64              
65             =head1 SYNOPSIS
66              
67             use Encoding::BER::Dumper;
68              
69             $ber = pl2ber( $perl );
70             $perl = ber2pl( $ber );
71              
72             =head1 DESCRIPTION
73              
74              
75             =head1 EXPORTS
76              
77             The following methods are exported:
78              
79             ber2pl, pl2ber
80              
81             =head1 BUGS
82              
83             Not all types of things perl can be encoded in BER.
84              
85             =head1 SEE ALSO
86              
87             Yellowstone National Park.
88             Encoding::BER, Data::Dumper, XML::Dumper
89              
90             =head1 AUTHOR
91              
92             Jeff Weisberg - http://www.tcp4me.com/
93              
94             =cut
95             ;
96            
97              
98             1;