package Audio::DB::Web;
# $Id: Web.pm,v 1.2 2005/02/27 16:56:25 todd Exp $
# ALL THE SQL queries need to be moved in dbi::mysql module
use strict 'vars';
use vars qw(@ISA $VERSION);
#use Apache::Constants qw(:common REDIRECT HTTP_NO_CONTENT);
use CGI qw/:standard *table *div *TR/;
use CGI::Cookie;
use DBI;
use Audio::DB;
use Audio::DB::Query;
use Audio::DB::Util::Rearrange;
use Audio::DB::Util::SystemConfig;
use Audio::DB::Util::Playlists;
use Audio::DB::DataTypes::Artist;
use Audio::DB::DataTypes::ArtistList;
use Audio::DB::DataTypes::Album;
use Audio::DB::DataTypes::AlbumList;
use Audio::DB::DataTypes::Genre;
use Audio::DB::DataTypes::GenreList;
use Audio::DB::DataTypes::Song;
use Audio::DB::DataTypes::SongList;
@ISA = qw/Audio::DB Audio::DB::Query/;
###################################################
# The new constructor is inherited from Audio::DB #
###################################################
# Farms out requests to various subs,
# creating the appropriate objects
sub process_requests {
my $self = shift;
return ($self->authenticate()) if (param('submit') eq 'Log In');
# Nothing to process if the action is a 'tryin'
# to retrieve the search form...passed as the 'search' value to the action key
return if (url_param('action') eq 'search');
# System Configuration, including user management
return Audio::DB::Util::SystemConfig->new($self->dbh) if (url_param('admin'));
# PLAYLISTS - Either trying to manipulate a playlist
# by a form, grab it by a url...
if (param('todo') eq 'add to playlist' || url_param('playlist')) {
return Audio::DB::Util::Playlists->new($self->{dbh},$self->{user_id});
} elsif (url_param('song_id')) {
return ($self->_fetch_song);
} else {
# Searches from the form
# Generating a coderef on the fly??
my $coderef = 'search' if param('search_term');
$coderef ||= url_param('action') . '_' . url_param('class')
if (url_param('action') && url_param('class'));
if ($coderef) {
my $results = $self->$coderef;
return $results;
}
}
}
################################
# Generic database manipulation
################################
# Used for adding playlists and new users to the database...
# This is a generic variant of the add...
sub add_entry {
my ($self,@p) = @_;
my ($table,$msg,$detailed,$user_id) = rearrange([qw/TABLE SUCCESS_MSG DETAILED USER_ID/],@p);
my $dbh = $self->{dbh};
Delete('submit');
my @params = param();
my (@cols,@quoted);
foreach (@params) {
push (@quoted,$dbh->quote(param($_)));
push (@cols,$_);
}
if ($user_id) {
push(@quoted,$user_id);
push(@cols,'user_id');
}
my $result = $dbh->do("insert into " . $table . "("
. join(",",@cols)
. ") VALUES ("
. join(",",@quoted) .")");
if ($result) {
print div({-class=>'success'},$msg);
if ($detailed) {
print start_div({-class=>'actioncontent'});
my @ordered_params = qw/first_name last_name username password email joined privs/;
print start_table(-width=>'50%');
foreach (@ordered_params) {
print TR(td($_),td(param($_)));
}
print end_table,end_div;
}
} else {
$self->print_sql_error($dbh->errstr);
}
}
# DEPRECATED BUT MAY BE USEFUL FOR GENERATING PAN QUERIES
## Should I expand the artist query?
#my %queries = (
# # Get a count of the distinct albums so
# # information can easily be presented on
# # a preliminary page without additional queries
# artist => qq{select *,COUNT(DISTINCT album)
# from artists,album_artists,albums
# where artist REGEXP ?
# and artists.artist_id=album_artists.artist_id
# and album_artists.album_id=albums.album_id
# GROUP by artist ORDER BY artist},
#
# # Group on album_id to keep from clobbering
# # albums of the same name
# album => qq{select * from albums,album_artists,artists
# where album REGEXP ?
# and albums.album_id=album_artists.album_id
# and album_artists.artist_id=artists.artist_id
# GROUP BY albums.album_id ORDER BY album},
#
# song => qq{select * from songs,artists,albums
# where song REGEXP ?
# and songs.artist_id=artists.artist_id
# and songs.album_id=albums.album_id
# GROUP by title ORDER by title}
# );
# SONG SEARCH NEEDS TO BE IMPLEMENTED
sub search {
my $self = shift;
my $class = lc param('class');
my $query = '.*' . param('search_term') . '.*';
my $field = $class;
# Create a generic container object of the appropriate class
# to return the results
my $this = bless { class=>ucfirst $field . 'List'},"Audio::DB::DataTypes::" .
ucfirst param('class') . 'List';
my $adaptor = $self->adaptor;
$this = $adaptor->generic_search(-class=>$class,
-query=>$query,
# -container=>$container);
);
return $this;
}
##########################################
# Miscellaneous formatting and navigation
##########################################
# Some navigation tools
sub browse_navigation {
my ($self,$msg) = @_;
my @values = qw/0-9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z/;
my @links;
foreach (@values) {
# This should be a constant
push @links,
a({-href=>"/music.cgi?action=browse&class=$msg&$msg=$_"},$_);
}
return \@links;
}
# If provided with a blessed object, generate a link to that object
# Optionally provided with a class, will link to that
# if that psuedo class exists within the object
# It's also possible to just pass in a "fake" (non-blessed)
# object for linking...
sub build_url {
my ($self,$class,$fake_object) = @_;
$class ||= $self->{class};
my ($link_text,$target);
if ($fake_object) {
$link_text = $fake_object->{$class};
# Kludge for column name
$link_text = $fake_object->{title} if ($class eq 'song');
$target = $fake_object->{$class . '_id'};
} else {
$link_text = $self->{$class};
$target = $self->{$class . '_id'};
# Kludge for column name
$link_text = $self->{title} if ($class eq 'song');
}
my $action = url_param('action') || 'browse';
my $primary = $class ."_id";
$link_text =~ s/[<>]//g;
$target =~ s/[<>]//g;
my $full_url = url();
my $url = '' . $link_text . "";
}
# Build up some generic URL for navigation
sub build_nav_link {
my ($self,@p) = @_;
my ($class,$action,$text) = rearrange([qw/CLASS ACTION TEXT/],@p);
my $url = url();
my $link = a({-href=>$url . '?' . $class . '=' . $action},$text);
return $link;
}
sub table_navigation {
my ($self,@p) = @_;
my ($type,$span) = rearrange([qw/TYPE SPAN/],@p);
my @values = qw/# A B C D E F G H I J K L M N O P Q R S T U V W X Y Z/;
print start_div({-class=>"navigation"});
print start_table();
my $count = 0;
foreach (@values) {
# End the previous row if necessary...
if ($count == $span) {
print end_TR;
$count = 0;
}
if ($count == 0) {
print start_TR({-class=>'navigation'});
}
print td({-class=>'navcell'},
a({-href=>"/music/music.cgi?action=browse&class=$type&$type=$_"},$_));
$count++;
}
print end_table;
print end_div;
}
# Display buttons for the bottom of the page
sub buttons {
my $self = shift;
my $playlists = Audio::DB::Util::Playlists->fetch_playlists(-type=>'by_user');
# my $playlists = $self->fetch_playlists(-type=>'by_user');
my $playlists = [];
my (@ids,%labels);
foreach (@$playlists) {
push (@ids,$_->{playlist_id});
$labels{$_->{playlist_id}} = $_->{playlist};
}
print start_table({-width=>'100%'});
print TR({-class=>'colheaders'},td('action'),td('tracks'),td('Available Playlists'),td(''));
print TR(
td(radio_group({-name=>'todo',
-values=>['stream','fetch','add to playlist'],
-linebreak=>1})),
# td(popup_menu({-values=>['stream','fetch','to playlist...']})),
td(radio_group({-name=>'the_chosen',
-values=>[qw/All Selected/],
-linebreak=>1})),
td(popup_menu({-name=>'playlist',
-values=>\@ids,
-labels=>\%labels})),
td(submit()));
print a({-href=>"javascript:OpenPlaylists(" . $self->{user_id} . ")"},
"Add to playlist...");
# print a({-onclick=>"window.open('music.cgi?action=add_to_playlist&user
#-href=>"javascript:OpenPlaylists(" . $self->{user_id} . ")"},
# "Add to playlist...");
}
# NEED TO FIGURE OUT HOW TO LINK IN...
# THIS BELONGS IN THE MODULE
sub print_checkboxes {
my ($self,$obj,$count) = @_;
my $class = $obj->class;
my $id_coderef = $class . '_id';
print
td({-align=>'center'},
checkbox({-name =>'checkbox' . $count,
-value =>$class . 's_' . $obj->$id_coderef,
-label => ''})
);
print td('stream');
}
#######################################
# Basic browsing and searching methods
#######################################
# This is for generic letter based browsing...
sub browse_by_letter {
my ($self,$field) = @_;
my $query = "^" . url_param($field) . '.*';
my $adaptor = $self->adaptor;
# This creates a container object in which to store everything
my $this = bless { class=>ucfirst $field . 'List'},"Audio::DB::DataTypes::" . ucfirst $field . 'List';
my $sth = $adaptor->fetch_by_letter($query,$field);
my $dbh = $self->dbh;
# This should all probably be moved to dbi::mysql since it has the fetchrow query
while (my $h = $sth->fetchrow_hashref) {
# Create brief summary objects of each of the albums or artists that are
# returned.
if ($field eq 'album') {
my $obj = Audio::DB::DataTypes::Album->new(-data=>$h);
push (@{$this->{albums}},$obj);
} else {
my $obj = Audio::DB::DataTypes::Artist->new(-data=>$h);
push (@{$this->{artists}},$obj);
}
}
return $this;
}
# Browse specific wrappers around different parameters
sub browse_genre {
my $self = shift;
my $artist_id = url_param('artist_id');
my $genre_id = url_param('genre_id');
my $adaptor = $self->adaptor;
# Browse by an artist id....
if ($artist_id) {
return (Audio::DB::DataTypes::Artist->new(-adaptor=>$adaptor,-id=>$artist_id));
# Or a genre id...
} elsif ($genre_id) {
return (Audio::DB::DataTypes::Genre->new(-adaptor=>$adaptor,-id=>$genre_id));
} else {
return (Audio::DB::DataTypes::GenreList->new(-adaptor=>$adaptor));
}
return;
}
sub browse_artist {
my $self = shift;
my $artist = url_param('artist');
my $artist_id = url_param('artist_id');
my $album_id = url_param('album_id');
my $adaptor = $self->adaptor;
# 2004: THIS SHOULD BE FETCH ARTIST...
if ($artist) {
return ($self->browse_by_letter('artist'));
} elsif ($album_id) {
return (Audio::DB::DataTypes::Album->new(-adaptor=>$adaptor,-id=>$album_id));
} else {
return (Audio::DB::DataTypes::Artist->new(-adaptor=>$adaptor,-id=>$artist_id));
}
}
sub browse_album {
my $self = shift;
my $album = url_param('album');
my $album_id = url_param('album_id');
my $adaptor = $self->adaptor;
my $results = [];
if ($album) {
return ($self->browse_by_letter('album'));
} elsif ($album_id) {
return (Audio::DB::DataTypes::Album->new(-adaptor=>$adaptor,-id=>$album_id));
} else { }
### EMPTY - SHOULD JUST RETURN THE NAVIGATION
# This should just return the naviagation...
# $results = $self->retrieve_artist();
# }
return $results;
}
# NOT YET IMPLEMENTED
sub _fetch_song {
my $self = shift;
my $dbh = $self->dbh;
my $sth = $dbh->prepare(qq{select * from songs,genres,artists,albums
where songs.song_id=?
and songs.artist_id=artists.artist_id
and songs.genre_id=genres.genre_id
and songs.album_id=albums.album_id});
$sth->execute(url_param('song_id'));
my $h = $sth->fetchrow_hashref;
return (Audio::DB::DataTypes::Song->new($h));
}
####################################
# Authentication and cookie control
####################################
# This is my simple-minded cookie-based authentication scheme
# Move into sql
#sub check_cookie {
# my $self = shift;
#
# # Fetch the cookie if there is one...
# my %cookie = cookie(-name => 'musicdb');
# my $user_id = $cookie{userid};
#
# # If a cookie was present, let's make sure to reset it ...
# if ($user_id) {
# $self->build_cookie($user_id);
# return;
# } elsif (param('submit') eq 'Log In') {
# $self->authenticate();
# } else {
# $self->{cookie} = 'NOT AUTHENTICATED';
# }
#}
#
#sub build_cookie {
# my ($self,$user_id) = @_;
# # Store the user id in the object for
# # building custom page elements
# $self->{user_id} = $user_id;
#
# # Could easily store more information in the cookie, too...
# my %vals = (userid => $user_id);
# my $cookie = cookie(-name =>'musicdb',
# -value=>\%vals);
# $self->{cookie} = $cookie;
# return;
#}
#
#sub authenticate {
# my $self = shift;
# my $password = param('password');
# my $dbh = $self->dbh;
# my $sth = $dbh->prepare(qq{select password,user_id from users where username=?});
# $sth->execute(param('username'));
# my ($pass,$user_id) = $sth->fetchrow_array;
# if ($pass eq $password) {
# $self->build_cookie($user_id);
# return;
# } else {
# $self->{cookie} = 'BOGUS GUESS';
# }
#}
1;
=pod
=head1 NAME
Audio::DB::Web - Assists in web-based queries of an MP3 Database
=head1 SYNOPSIS
use Audio::DB::Web;
my $mp3->
=head1 DESCRIPTION
Audio::DB is a module for creating relational databases of MP3 files directly
from data stored in ID3 tags. Once created, Audio::DB provides various
methods for creating reports and web pages of your collection. Although
it's nutritious and delicious on its own, Audio::DB was created for use
with Apache::Audio::DB, a subclass of Apache::MP3. This module makes it
easy to make your collection web-accessible, complete with browsing,
searching, streaming, multiple users, playlists, ratings, and more!
=head1 REQUIRES
This module is designed to work with the data schema created
and loaded by B. It's not going to do you mch good without it.
=head1 EXPORTS
No methods are exported.
=head1 CAVEATS
=head1 METHODS
=head2 fetch_user_playlists();
Title : fetch_user_playlists
Usage : $mp3->fetch_user_playlists();
Function : fetches all playlists
Returns : A hash reference relating user playlist names to IDs
suitable for building forms.
Args : -filled
Status : Public
Methods:
user management
multiplaylists / user (and option to share with others)
user ratings (for songs and playlists)
browse by letter of alphabet, genre, album
Stats reporting
=head1 NAME
Apache::Audio::DB - Generate a database of your tunes complete with searchable interface and nifty statistical analyses!
=head1 SYNOPSIS
# httpd.conf or srm.conf
AddType audio/mpeg mp3 MP3
# httpd.conf or access.conf
SetHandler perl-script
PerlHandler Apache::MP3::Sorted
PerlSetVar SortFields Album,Title,-Duration
PerlSetVar Fields Title,Artist,Album,Duration
=head1 TODO
Streaming code and links
BUILDING URLs from non-blessed items...need to handle this because
it will come up alot
DB.pm Use lincolns code for scanning files
Browse filesystem
Update DB scripts
HTML module of common formatting options
configuration page...
limits to return
option to download tarballs
Figure out how to track paths and such...
Preserving this state is kinda hairy
CLEAN UP THE BUILD URL SUB
OPTIMIZE QUERIES AND OBJECT CONSTRUCTION
SEPEERATE OUT OBJECT CODE
Seperate out HTML formatting into a seperate module
Error checking and handling
Streaming code
Column Sorting
User management
Playlist integration
Playlist sharing
Multiple Playlists
Interface preferences
=head1 DESCRIPTION
Apache::Audio::DB subclasses Apache::MP3 to generate a relational database
of your music collection. This allows browsing by various criteria that
are not available when simply browsing the filesystem. For example,
users my browse by genre, year, or era. Apache::Audio::DB also provides
search capabilities.
=head1 CUSTOMIZING
This class adds several new Apache configuration variable.
Database specific variables:
----------------------------
Value Default
PerlSetVar DB_Name database name musicdb
PerlSetVar Create boolean no
PerlSetVar Host database user name localhost
PerlSetVar User user name
PerlSetVar Password db password
=over 4
=item B I
This is the name of the database. If not provided, musicdb will be used.
=item B
Examples:
PerlSetVar SortFields Album,Title # sort ascending by album, then title
PerlSetVar SortFields +Artist,-Kbps # sort ascending by artist, descending by kbps
When constructing a playlist from a recursive directory listing,
sorting will be B across all directories. If no sort order is
specified, then the module reverts to sorting by file and directory
name. A good value for SortFields is to sort by Artist,Album and
track:
PerlSetVar SortFields Artist,Album,Track
Alternatively, you might want to sort by Description, which
effectively sorts by title, artist and album.
The following are valid fields:
Field Description
album The album
artist The artist
bitrate Streaming rate of song in kbps
comment The comment field
description Description, as controlled by DescriptionFormat
duration Duration of the song in hour, minute, second format
filename The physical name of the .mp3 file
genre The genre
samplerate Sample rate, in KHz
seconds Duration of the song in seconds
title The title of the song
track The track number
Field names are case insensitive.
=back
=head1 METHODS
Apache::MP3::Sorted overrides the following methods:
sort_mp3s() mp3_table_header() mp3_list_bottom()
It adds one new method:
=over 4
=item $field = $mp3->sort_fields
Returns a list of the names of the fields to sort on by default.
#### UI ELEMENTS THAT HAVEN'T BEEN REWORKED YET
#sub amg_link {
# my ($artist,$link_text) = @_;
# # Encode $artist for searching: UC, replace \s with |, replace ' and ,
# my $artist_encoded = uc $artist;
# $artist_encoded =~ s/\s/|/g;
# $artist_encoded =~ s/[,\'\-]//g;
# my $base_url = 'http://allmusic.com/cg/x.dll?p=amg&optl=1&sql=1';
# my $full_url = $base_url . $artist_encoded;
# # Formulate the AMG URL
# my $amg_link = '' .
# $link_text . "";
# return($amg_link);
#}
#sub print_search_button {
# print center(
# startform(-action=>$full_url),
# submit(-name=>'submit',
# -value=>'Search Again'),
# endform);
# return;
#}