File Coverage

blib/lib/Boulder/Util.pm

Criterion	Covered	Total	%
statement	15	62	24.1
branch	0	32	0.0
condition	0	3	0.0
subroutine	5	8	62.5
pod	2	3	66.6
total	22	108	20.3

# Copyright (c) 2004-2005 Timothy Appnel
# http://www.timaoutloud.org/
# This code is released under the Artistic License.
#
# Boulder::Util - Utility methods for simple Boulder IO interactions.
#

package Boulder::Util;

use strict;
use CGI::Util qw( unescape escape );

use vars qw( $VERSION @EXPORT_OK);
$VERSION = '0.1';

require Exporter;
@Boulder::Util::ISA = qw(Exporter);
@EXPORT_OK          = qw( boulder_save boulder_load HASH QUERY );

use constant HASH  => 1;
use constant QUERY => 2;

sub boulder_save {
    my ( $filehandle, $data ) = @_;
    $filehandle = to_filehandle($filehandle);
    local ($,) = '';
    local ($\) = '';
    $data = [$data] if ( ref($data) eq 'HASH' );
    foreach my $rec (@$data) {
        my $param;
        foreach $param ( keys %$rec ) {
            my ($escaped_param) = escape($param);
            my @vals =
              ref( $rec->{$param} ) eq 'ARRAY'
              ? @{ $rec->{$param} }
              : ( $rec->{$param} );
            my $v;
            foreach $v (@vals) {
                print $filehandle "$escaped_param=", escape("$v"), "\n";
            }
        }
        print $filehandle "=\n";
    }
}

sub boulder_load {
    my ( $filehandle, $mode ) = @_;
    my @lines;
    if ( defined($filehandle) && ( $filehandle ne '' ) ) {
        while (<$filehandle>) {
            chomp;
            last if /^=/;
            push( @lines, $_ );
        }
    }
    return undef unless @lines;
    return "@lines" =~ /=/ ? join( "&", @lines ) : join( "+", @lines )
      if $mode == QUERY;
    my %hash;
    foreach (@lines) {
        my ( $key, $value ) = split /=/, $_, 2;
        next unless $key;
        $value = unescape($value);
        unless ( exists( $hash{$key} ) ) {
            $hash{$key} = $value;
            next;
        }
        if ( ref( $hash{$key} ) eq 'ARRAY' ) {
            push( @{ $hash{$key} }, $value );
        } else {
            $hash{$key} = [ $hash{$key}, $value ];
        }
    }
    \%hash;
}

# Borrowed from CGI so we don't have to load that package if
# we don't need to. Turns a string into a filehandle.
sub to_filehandle {
    my $thingy = shift;
    return undef unless $thingy;
    return $thingy if UNIVERSAL::isa( $thingy, 'GLOB' );
    return $thingy if UNIVERSAL::isa( $thingy, 'FileHandle' );
    if ( !ref($thingy) ) {
        my $caller = 1;
        while ( my $package = caller( $caller++ ) ) {
            my ($tmp) =
                $thingy =~ /[\':]/
              ? $thingy
              : "$package\:\:$thingy";
            return $tmp if defined( fileno($tmp) );
        }
    }
    return undef;
}

1;

__END__