package HTML::Pen::Utils ;
require Exporter;
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Contessa::Demo ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' =>
[ qw( split memstat mymkdir imagefile randomize ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );
our $VERSION = '0.01';
sub mysplit {
my $pat = shift ;
my $t = shift ;
return ( $t ) if ref $t eq 'SCALAR' ;
return () if ref $t ;
my @rv ;
while ( $t =~ s/^(.*?)($pat)//s ) { ;
my @o = ( $1, $2 ) ;
push @rv, $o[0], \( $o[1] ) ;
} ;
push @rv, $t ;
return @rv ;
}
sub split {
my $t = shift @_ ;
my @rv ;
while ( @_ ) {
if ( @rv ) {
my $p = shift @_ ;
@rv = map { mysplit( $p, $_ ) } @rv ;
}
else {
@rv = mysplit( shift @_, $t ) ;
}
}
return map { ref $_? $$_: $_ } @rv ;
}
sub memstat {
if( ! open( _INFO, "< /proc/$$/statm" ) ) {
warn "Couldn't open /proc/$$/statm [$!]" ;
return {} ;
}
my @info = split( /\s+/, <_INFO> ) ;
close( _INFO ) ;
return { size => $info[0] * 4,
resident => $info[1] * 4,
shared => $info[2] * 4 } ;
}
## utility
sub mymkdir {
my $dir = shift ;
mkdir $dir unless -d $dir ;
return unless scalar @_ ;
my $next = shift ;
return mymkdir( join( '/', $dir, $next ), @_ ) ;
}
sub imagefile {
my $fn = shift ;
my $buff = shift ;
$fn =~ s|^/|| ;
my @fn = split m|/|, $fn ;
pop @fn ;
mymkdir( @fn ) ;
open $f, "> $fn" ;
print $f $buff ;
close $f ;
}
sub randomize {
# srand() ;
my @p = @_ ;
my @rv = () ;
push @rv, splice @p, int( rand( scalar @p ) ), 1 while @p ;
return @rv ;
}
1
__END__
my best parser yet. (10/2003)
@s = Pen::Utils::split( $t, '\[.*?\]', '".*?"', '\s+' ) ;
The above protects quoted spaces and text enclosed in brackets. Note, all
elements are returned. So filter out separators as follows:
print join "\n", grep /\S/, @s ;