view release on metacpan or  search on metacpan

RAM.pm  view on Meta::CPAN

        my @col_names = split ',',$catalog->{col_names};
        my $count =0;
        for (@col_names) {
            $fieldStr .= "<$_>$fields->[$count]</$_>";
            $count++;
	}
        return $fieldStr;
    }
    for(@$fields) {
        # PAD OR TRUNCATE DATA TO FIT WITHIN FIELD LENGTHS
        if( $catalog->{f_type} eq 'FIX' ) {
            my $oldLen = length $_;
            my $newLen =  $fieldLengths[$fieldNum];
            if ($oldLen < $newLen) { $_ = sprintf "%-${newLen}s",$_; }
  	    if ($oldLen > $newLen) { $_ = substr $_, 0, $newLen; }
            $fieldNum++;
        }
        my $newCol = $_;
        if( $catalog->{f_type} eq 'CSV' ) {
             if ($newCol =~ /$sep/ ) {
                 $newCol =~ s/\042/\\\042/go;
                 $newCol = qq{"$newCol"};
	     }
             $fieldStr .= $newCol . $wsep;
        }
        else { $fieldStr .= $newCol; 	}
        if( $catalog->{f_type} eq 'INI' ) { $fieldStr .= '='; }
    }
    if( $catalog->{f_type} eq 'CSV' ) { $fieldStr =~ s/$sep$//; }
    if( $catalog->{f_type} eq 'INI' ) { $fieldStr =~ s/=$//; }
    return $fieldStr;
}

sub get_music_library {
    my $specs = shift;
    my @dirs = @{$specs->{dirs}};
    my @db;
    for my $dir(@dirs) {
        my @files = get_music_dir( $dir );
        for my $fname(@files) {
            push @db, &get_mp3_tag($fname)
        }
    }
    return \@db;
}

sub get_music_dir {
    my $dir  = shift;
    opendir(D,$dir) || print "$dir: $!\n";
    return '' if $!;
    my @files = grep /mp3$/i, readdir D;
    @files = map ( $_ = $dir . $_, @files);
    closedir(D) || print "Couldn't read '$dir':$!";
    return @files;
}

sub get_mp3_tag {
    my($file)   = shift;
    open(I,$file) || return '';
    binmode I;
    local $/ = '';
    seek I, -128, 2;
    my $str = <I> || '';
    return '' if !($str =~ /^TAG/);
    $file = sprintf("%-255s",$file);
    $str =~ s/^TAG(.*)/$file$1/;
    my $genre = $str;
    $genre =~ s/^.*(.)$/$1/g;
    $str =~ s/(.)$//g;
    $genre = unpack( 'C', $genre );
my @genres =("Blues", "Classic Rock", "Country", "Dance", "Disco", "Funk", "Grunge", "Hip-Hop", "Jazz", "Metal", "New Age", "Oldies", "Other", "Pop", "R&B", "Rap", "Reggae", "Rock", "Techno", "Industrial", "Alternative", "Ska", "Death Metal", "Pranks...
    $genre = $genres[$genre] || '';
    $str .= $genre . "\n";
    return $str;
}


# END OF DRIVER PRIVATE METHODS

sub table_info ($) {
	my($dbh) = @_;
        my @tables;
        for (keys %{$DBD::RAM::ramdata} ) {
             push(@tables, [undef, undef, $_, "TABLE", undef]);
	}
        my $names = ['TABLE_QUALIFIER', 'TABLE_OWNER', 'TABLE_NAME',
                     'TABLE_TYPE', 'REMARKS'];
 	my $dbh2 = $dbh->{'csv_sponge_driver'};
	if (!$dbh2) {
	    $dbh2 = $dbh->{'csv_sponge_driver'} = DBI->connect("DBI:Sponge:");
	    if (!$dbh2) {
	        DBI::set_err($dbh, 1, $DBI::errstr);
		return undef;
	    }
	}

	# Temporary kludge: DBD::Sponge dies if @tables is empty. :-(
	return undef if !@tables;

	my $sth = $dbh2->prepare("TABLE_INFO", { 'rows' => \@tables,
						 'NAMES' => $names });
	if (!$sth) {
	    DBI::set_err($dbh, 1, $dbh2->errstr());
	}
	$sth;
}

sub DESTROY { $DBD::RAM::ramdata = {};}

package DBD::RAM::st; # ====== STATEMENT ======

$DBD::RAM::st::imp_data_size = 0;
@DBD::RAM::st::ISA = qw(DBD::File::st);


package DBD::RAM::Statement;

#@DBD::RAM::Statement::ISA = qw(SQL::Statement);
@DBD::RAM::Statement::ISA = qw(SQL::Statement DBD::File::Statement);
#@DBD::RAM::Statement::ISA = qw(DBD::File::Statement);