/usr/share/perl5/Prophet/Util.pm is in libprophet-perl 0.750-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 | package Prophet::Util;
use strict;
use File::Basename;
use File::Spec;
use File::Path;
use Params::Validate;
use Cwd;
=head2 updir PATH, DEPTH
Strips off the filename in the given path and returns the absolute
path of the remaining directory.
Default depth is 1.
If depth are great than 1, will go up more according to the depth value.
=cut
sub updir {
my $self = shift;
my ( $path, $depth ) = validate_pos( @_, 1, { default => 1 } );
die "depth must be positive" unless $depth > 0;
my ($file, $dir, undef) = fileparse(File::Spec->rel2abs($path));
$depth-- if $file; # we stripped the file part
if ($depth) {
$dir = File::Spec->catdir( $dir, ( File::Spec->updir ) x $depth );
}
# if $dir doesn't exists in file system, abs_path will return empty
return Cwd::abs_path($dir) || $dir;
}
=head2 slurp FILENAME
Reads in the entire file whose absolute path is given by FILENAME and
returns its contents, either in a scalar or in an array of lines,
depending on the context.
=cut
sub slurp {
my $self = shift;
my $abspath = shift;
open (my $fh, "<", "$abspath") || die "$abspath: $!";
my @lines = <$fh>;
close $fh;
return wantarray ? @lines : join('',@lines);
}
=head2 instantiate_record class => 'record-class-name', uuid => 'record-uuid', app_handle => $self->app_handle
Takes the name of a record class (must subclass L<Prophet::Record>), a uuid,
and an application handle and returns a new instantiated record object
of the given class.
=cut
sub instantiate_record {
my $self = shift;
my %args = validate(@_, {
class => 1,
uuid => 1,
app_handle => 1
});
die $args{class} ." is not a valid class " unless (UNIVERSAL::isa($args{class}, 'Prophet::Record'));
my $object = $args{class}->new( uuid => $args{uuid}, app_handle => $args{app_handle});
return $object;
}
=head2 escape_utf8 REF
Given a reference to a scalar, escapes special characters (currently just &, <,
>, (, ), ", and ') for use in HTML and XML.
Not an object routine (call as Prophet::Util::escape_utf8( \$scalar) ).
=cut
sub escape_utf8 {
my $ref = shift;
no warnings 'uninitialized';
$$ref =~ s/&/&/g;
$$ref =~ s/</</g;
$$ref =~ s/>/>/g;
$$ref =~ s/\(/(/g;
$$ref =~ s/\)/)/g;
$$ref =~ s/"/"/g;
$$ref =~ s/'/'/g;
}
sub write_file {
my $self = shift;
my %args = (@_); #validate is too heavy to be called here
# my %args = validate( @_, { file => 1, content => 1 } );
my ( undef, $parent, $filename ) = File::Spec->splitpath($args{file});
unless ( -d $parent ) {
eval { mkpath( [$parent] ) };
if ( my $msg = $@ ) {
die "Failed to create directory " . $parent . " - $msg";
}
}
open( my $fh, ">", $args{file} ) || die $!;
print $fh scalar( $args{'content'} )
; # can't do "||" as we die if we print 0" || die "Could not write to " . $args{'path'} . " " . $!;
close $fh || die $!;
}
sub hashed_dir_name {
my $hash = shift;
return ( substr( $hash, 0, 1 ), substr( $hash, 1, 1 ), $hash );
}
sub catfile {
my $self = shift;
# File::Spec::catfile is more correct, but
# eats over 10% of prophet app runtime,
# which isn't acceptable.
return join('/',@_);
}
1;
|