/usr/share/perl5/XML/Compile/Dumper.pm is in libxml-compile-dumper-perl 0.13-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | # Copyrights 2007-2010 by Mark Overmeer.
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 1.06.
use warnings;
use strict;
package XML::Compile::Dumper;
use vars '$VERSION';
$VERSION = '0.13';
use Log::Report 'xml-compile', syntax => 'SHORT';
use Data::Dump::Streamer;
use POSIX qw/asctime/;
use IO::File;
# I have no idea why the next is needed, but without it, the
# tests are failing.
use XML::Compile::Schema;
sub new(@)
{ my ($class, %opts) = @_;
(bless {}, $class)->init(\%opts);
}
sub init($)
{ my ($self, $opts) = @_;
my $fh = $opts->{filehandle};
unless($fh)
{ my $fn = $opts->{filename}
or error __x"either filename or filehandle required";
$fh = IO::File->new($fn, '>:utf8')
or fault __x"cannot write to {filename}", filename => $fn;
}
$self->{XCD_fh} = $fh;
my $package = $opts->{package}
or error __x"package name required";
$self->header($fh, $package);
$self;
}
sub close()
{ my $self = shift;
my $fh = $self->file or return 1;
$self->footer($fh);
delete $self->{XCD_fh};
$fh->close;
}
sub DESTROY()
{ my $self = shift;
$self->close;
}
sub file() {shift->{XCD_fh}}
sub header($$)
{ my ($self, $fh, $package) = @_;
my $date = asctime localtime;
$date =~ s/\n.*//;
$fh->print( <<__HEADER );
#crash
# This module has been generated using
# XML::Compile $XML::Compile::VERSION
# Data::Dump::Streamer $Data::Dump::Streamer::VERSION
# Created with a script
# named $0
# on $date
use warnings;
no warnings 'once';
no strict; # sorry
package $package;
use base 'Exporter';
use XML::LibXML ();
use Log::Report;
our \@EXPORT;
__HEADER
}
sub freeze(@)
{ my $self = shift;
error "freeze needs PAIRS or a HASH"
if (@_==1 && ref $_[0] ne 'HASH') || @_ % 2;
error "freeze can only be called once"
if $self->{XCD_freeze}++;
my (@names, @data);
if(@_==1) # Hash
{ my $h = shift;
@names = keys %$h;
@data = values %$h;
}
else # Pairs
{ while(@_)
{ push @names, shift;
push @data, shift;
}
}
my $fh = $self->file;
my $export = join "\n ", sort @names;
$fh->print("push \@EXPORT, qw/\n $export/;\n\n");
Data::Dump::Streamer->new->To($fh)->Data(@data)->Out;
for(my $i = 0; $i < @names; $i++)
{ ref $data[$i] eq 'CODE'
or error __x"value with '{label}' is not a code reference"
, label => $names[$i];
my $code = '$CODE'.($i+1);
$fh->print("*${names[$i]} = $code;\n");
}
}
sub footer($)
{ my ($self, $fh) = @_;
$fh->print( "\n1;\n" );
}
1;
|