From fa170afd817648f306e322802ca85b6abbd37f74 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 21 Jun 2011 16:33:26 +0200 Subject: Initial commit --- cgi-bin/Globals.pm | 229 +++++++++++++++++++++++ cgi-bin/Search.pm | 307 +++++++++++++++++++++++++++++++ cgi-bin/abcmanager.plx | 33 ++++ cgi-bin/artist.plx | 141 ++++++++++++++ cgi-bin/front.plx | 109 +++++++++++ cgi-bin/hosts.plx | 45 +++++ cgi-bin/news.plx | 47 +++++ cgi-bin/playlists/album.pm | 197 ++++++++++++++++++++ cgi-bin/playlists/artistlist.pm | 78 ++++++++ cgi-bin/playlists/extm3u.pm | 36 ++++ cgi-bin/playlists/extpls.pm | 39 ++++ cgi-bin/playlists/extrmp.pm | 53 ++++++ cgi-bin/playlists/extwvx.pm | 64 +++++++ cgi-bin/playlists/playlist.pm | 33 ++++ cgi-bin/playlists/tracks.pm | 85 +++++++++ cgi-bin/search.plx | 127 +++++++++++++ cgi-bin/searchplugin.plx | 25 +++ cgi-bin/servernews.plx | 72 ++++++++ cgi-bin/settings.plx | 92 ++++++++++ cgi-bin/trawler.plx | 393 ++++++++++++++++++++++++++++++++++++++++ 20 files changed, 2205 insertions(+) create mode 100644 cgi-bin/Globals.pm create mode 100644 cgi-bin/Search.pm create mode 100644 cgi-bin/abcmanager.plx create mode 100644 cgi-bin/artist.plx create mode 100644 cgi-bin/front.plx create mode 100644 cgi-bin/hosts.plx create mode 100644 cgi-bin/news.plx create mode 100644 cgi-bin/playlists/album.pm create mode 100644 cgi-bin/playlists/artistlist.pm create mode 100644 cgi-bin/playlists/extm3u.pm create mode 100644 cgi-bin/playlists/extpls.pm create mode 100644 cgi-bin/playlists/extrmp.pm create mode 100644 cgi-bin/playlists/extwvx.pm create mode 100644 cgi-bin/playlists/playlist.pm create mode 100644 cgi-bin/playlists/tracks.pm create mode 100644 cgi-bin/search.plx create mode 100644 cgi-bin/searchplugin.plx create mode 100644 cgi-bin/servernews.plx create mode 100644 cgi-bin/settings.plx create mode 100644 cgi-bin/trawler.plx (limited to 'cgi-bin') diff --git a/cgi-bin/Globals.pm b/cgi-bin/Globals.pm new file mode 100644 index 0000000..c4695b2 --- /dev/null +++ b/cgi-bin/Globals.pm @@ -0,0 +1,229 @@ +# Utils package +# Loads all config files, and supplies common functions + +package Globals; +use strict; +use URI::Escape; +use URI::URL; +use HTML::Entities (); +use CGI; +use LWP::UserAgent; +require LWP; +use URI; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use vars qw(@MUSIC @VIDEO @CUSTOM @SHORTCUT $CGIROOT $APPNAME $MINTRAWL %PLATTERS %ALLPLATTERS $VERSION + $debug $delim $target $tracklink $audioRocketman $videoRocketman $bgcolour); + +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(makeUnNice makeNice makeHTML getFile openTemplate getABCs makeJs getArtistString makeTrackPlaylist makeTrackURL getPlatterStats); +@EXPORT_OK = qw(@MUSIC @VIDEO @CUSTOM @SHORTCUT $CGIROOT $APPNAME $MINTRAWL %PLATTERS %ALLPLATTERS $VERSION + $delim $debug $target $audioRocketman $videoRocketman $bgcolour); + +$CGIROOT = "localhost"; +$APPNAME = "distroplat"; +$VERSION = "£3 6s 0d"; +$MINTRAWL = 30; +$debug = 0; +$delim = chr(255); + +open(CONF, "../data/distroplat.conf") or die "No config file found"; +my $list; +while () { + s/#.*//; + chomp; + my $line = $_; + if (length($line) == 0) { next } + if ($line =~/^\s*\[music\]/i) { $list = \@MUSIC; next } + if ($line =~/^\s*\[video\]/i) { $list = \@VIDEO; next } + if ($line =~/^\s*\[shortcut\]/i) { $list = \@SHORTCUT; next } + if ($line =~/^\s*\[customfolders\]/i) { $list = \@CUSTOM; next } + if ($line =~/^\s*cgiroot\s*=\s*(.*)/i) { $CGIROOT = $1; next } + if ($line =~/^\s*appname\s*=\s*(.*)/i) { $APPNAME = $1; next } + if ($line =~/^\s*colour\s*=\s*(.*)/i) { $bgcolour = $1; next } + if ($line =~/^\s*mintrawl\s*=\s*(.*)/i) { $MINTRAWL = $1; next } + if ($line =~/^\s*audioRocketman\s*=\s*(.*)/i) { $audioRocketman = $1; next } + if ($line =~/^\s*videoRocketman\s*=\s*(.*)/i) { $videoRocketman = $1; next } + if ($line =~/^\s*debug/i) { $debug = 1; next } + + push @$list, $line; +} + +if ($debug) { print "HTTP/1.0 200 OK\nContent-type: text/plain\n\n"; } + +close CONF; + +# Init CGI +my $query = CGI::new(); + +# Load server file +my $exclude = $query->cookie('exclude'); + +open ( SERVERS, "../data/servers.txt" ) or die "No servers file found"; +while ( ) +{ + chomp; + my @INLINE = split ( / /, $_ ); + my $NAME = $INLINE[ 0 ]; + my $URL = $INLINE[ 1 ]; + if ($URL =~ /\/$/) { chop $URL; } + unless ($exclude =~ /$NAME,/) { $PLATTERS{ $NAME } = $URL; } + $ALLPLATTERS{ $NAME } = $URL; +} +close SERVERS; + +# target makes users with small screens open searches and artists full frame +# instead of in a window + +$target = $query->cookie('target'); +$target = 'iframe' unless $target; + +# abcs are loaded in a function because it's expensive and not used much +sub getABCs { + my %ABCS; + open (ABC, "../inventory/abcs.txt"); + while () { + chop; + my @thisabc = split($delim); + $ABCS{$thisabc[0]} = $thisabc[1]; + } + close(ABC); + return %ABCS; +} +# Unified MakeNice/UnNice + +sub makeUnNice( @_ ) +{ + my $UNNICE = $_[ 0 ]; + + $UNNICE = uri_escape($UNNICE); + # These things break reglier expressions + $UNNICE =~ s/\(/%28/g; + $UNNICE =~ s/\)/%29/g; + $UNNICE =~ s/\&/%26/g; + $UNNICE =~ s/\+/%2B/g; + $UNNICE =~ s/%2F/\//gi; # some versions of uri_escape escape forward slashes + return $UNNICE; +} + +sub makeNice( @_ ) +{ + my $NICE; + $NICE = uri_unescape($_[0]); + $NICE =~ s/([^\/]*),\sThe$/The $1/gi; + $NICE =~ s/(^|\/)\d{2} - /$1/g; + + $NICE =~ s/\.($_)$/ (Video)/gi foreach ( @VIDEO ) ; + $NICE =~ s/\.($_)$//gi foreach ( @MUSIC ) ; + $NICE =~ s/\.($_)$//gi foreach ( @SHORTCUT ) ; + $NICE =~ s/^Singles\//Single - /; + return $NICE; +} + +sub makeJs( @_ ) +{ + my ($NICE) = @_; + $NICE =~ s/'/\\'/g; + return $NICE; +} + +sub makeHTML( @_ ) +{ + my ($NICE) = @_; + $NICE = $NICE; + $NICE = HTML::Entities::encode($NICE); + $NICE =~ s/\s(\(.*\))$/ <\/a> $1<\/i>/; + return $NICE; +} + +sub getFile( @_ ) +{ + my ($INURL) = @_; + + my $INFO; + my $HEADER = new HTTP::Headers( 'Accept' => 'text/plain', 'User-Agent' => 'PlatterTwaartter/1.0' ); + my $URL = new URI::URL( $INURL ); + my $REQUEST = new HTTP::Request( 'GET', $URL, $HEADER ); + my $UAGENT = new LWP::UserAgent; + my $RESPONSE = $UAGENT -> request( $REQUEST ); + + # Did we get a 200? + # + if ( $RESPONSE -> is_success ) + { + return $RESPONSE -> content; + } + + return "Error fetching ".$INURL; +} + +# opens a template file and returns it as a string +# +sub openTemplate( @_ ) +{ + my $TEMPLATE; + + open FILE, "../templates/".$_[ 0 ].".template" or die "Could not find template ".$_[0]; + + while( ) + { + $TEMPLATE .= $_; + } + + close FILE; + + return $TEMPLATE; +} + +sub getArtistString( @_ ) { + my ($folder, $trackartist) = @_; + my $artist; + foreach (@CUSTOM) { $folder = undef if /^$folder$/ } + if ($folder && $trackartist) { $artist = "$folder & $trackartist" } + elsif ($folder) { $artist = $folder } + elsif ($trackartist) { $artist = $trackartist } + else {$artist = 'Unknown'}; + + return $artist; +} + +sub makeTrackPlaylist( @_ ) { + my ($folder, $trackartist, $album, $track, $platter) = @_; + + my $linkartist = $folder; + $linkartist= $trackartist if (length $trackartist > 0); + $album= 'Miscellany' if (length $album == 0); + return "search.plx?artist=".makeUnNice($linkartist)."&album=".makeUnNice($album)."&title=".makeUnNice($track)."&exact=1&searchFor=track&inv=$platter&filter=music,video,shortcut"; +} + +sub makeTrackURL( @_ ) { + my ($platter, $url, $folder, $trackartist, $title) = @_; + + foreach (@SHORTCUT) { + if ($url =~ /$_$/) { # is a shortcut + my $thisartist = $trackartist; + $thisartist = $folder unless (length $trackartist); + return "http://$CGIROOT/$APPNAME/search.plx?artist=".makeUnNice($thisartist)."&title=".makeUnNice($title)."&exact=1&output=redir"; + } + } + + return 'http://'.$platter.$url; +} + +sub getPlatterStats( @_ ) { + my ($platter) = @_; + my $artists=0; + my $tracks=-1; + open (INV, "../inventory/".$platter.".inv"); + my $line; + while ($line = ) { + $tracks++ unless($line =~ /^http/); + } + $tracks = 0 if $tracks < 1; + close INV; + open (ARTIST, "../inventory/".$platter.".artist"); + $artists++ while (); + close ARTIST; + return ($tracks, $artists); +} + diff --git a/cgi-bin/Search.pm b/cgi-bin/Search.pm new file mode 100644 index 0000000..af6b3fd --- /dev/null +++ b/cgi-bin/Search.pm @@ -0,0 +1,307 @@ +# included script to provide platter search +# artist, album, song, date, number of random tracks to take, +# scope (misc or album), inventory +# +# returns list of matching lines + +package Search; +use Globals; +use Globals qw(@CUSTOM); +use Globals qw($delim); +use Globals qw($debug); +use Globals qw(%PLATTERS); + +use strict; + +my $artist = undef; +my $title = undef; +my $album = undef; +my $dateFrom = undef; +my $dateTo = undef; +my $scope = undef; +my $random = undef; +my $exclTypes = undef; +my $exact = 0; +my $searchFor = undef; #artist|album|track +my @inv = (); +my @filter = (); +my %ABCS; + + +return 1; + +sub setArtist { + my ($thisartist) = @_; + $thisartist =~ s/^The //i; + $thisartist =~ s/, The$//i; + $artist = $thisartist; +} + +sub setTitle { + $title = $_[0]; +} + +sub setAlbum { + $album = $_[0]; +} + +sub setDateFrom { + ($dateFrom) = @_ unless ($_[0] =~ /^1900$/); +} + +sub setDateTo { + ($dateTo) = @_ unless ($_[0] =~ /^2525$/); +} + +sub setScope { + ($scope) = @_; + $scope = 'all' if (!$scope); +} + +sub setRandom { + ($random) = @_; +} + +sub setInv { + @inv = @_; +} + +sub setExact { + ($exact) = @_; +} + +sub setFilter { + @filter = @_; +} + +sub setExclTypes { + ($exclTypes) = @_; +} + +sub searchFor { + ($searchFor) = @_; +} + +sub go { + + my @result = (); + + #load abcs + if ($searchFor eq 'artist') { %ABCS = getABCs() } + + # decide if we can skip opening the inventories + my $pureArtistSearch = ($searchFor eq 'artist' && !$title && !$album && !$dateFrom && !$dateTo && $scope eq 'all'); + + # loop through each platter + @inv = keys %PLATTERS if (!defined @inv); + + foreach (@inv) { + my $platter = $_; + my $base; + + # Check the artist cache + if (open (ARTIST, "../inventory/".$platter.".artist")) { + my $useplatter; + while () { + chomp; + my $thisArtist = $_; + if (!$artist || + ($exact && # want exact match + $thisArtist =~ /^\Q$artist\E$/i) || + (!$exact && # not exact + $thisArtist =~ /\Q$artist\E/i)) { + if (!$exact && # but we weren't doing an exact search + $thisArtist =~ /^\Q$artist\E$/i && + $searchFor eq 'artist' && $artist) { # bail out just returning the artist name for redirect + return (makeNice($thisArtist)); + } + if ($pureArtistSearch) { # store in result + push (@result, makeABC($thisArtist)); + } + else { # examine this platter further + $useplatter = 1; + print "Using $platter\n" if ($debug); + last; + } + } + } + next if !$useplatter; + } + + if (!$pureArtistSearch) { # Only continue with full inv search if artist cache didn't populate the results + + # Open the inventory + + open (PLATTER, "../inventory/".$platter.".inv"); + while () { + chomp; + my $raw = $_; + if ($raw =~ /^http\:\/\//) { # is the base url + $base = $raw; + next; + } + + my ($folder, $trackartist, $trackalbum, $year, $track, $url) = split ($delim, $raw); + + # apply filter + my $filetype = substr($url, rindex($url, '.')+1); + next if ($exclTypes =~ /$filetype,/); + if ($#filter > -1) { + my $match = 0; + #print "$filetype\n"; + foreach( @filter ) { + if (/^$filetype$/i) { $match = 1; last; } + } + if (!$match) { next; } + } + + + # Match Scope + + if ($scope && $scope ne "all") { + if (length ($trackalbum) == 0) { + next if ($scope eq 'album'); + } + else { + next if ($scope eq 'misc'); + } + } + + # Match Track Title + if ($title) { + unless (($exact && # want exact match + $track =~ /^(\d{2} - |)\Q$title\E(\.[^\.]*|)$/i) + || + (!($exact) && # not exact + $track =~ /\Q$title\E/i)) { + next; + } + } + + # Match Artist + if ($artist) { + unless ($exact && # want exact match + ($folder =~ /^\Q$artist\E$/i || # artist folder + ($trackartist =~ /^\Q$artist\E$/i )) + # track artist (not on album searches) + || + (!($exact) && # not exact + ($folder =~ /\Q$artist\E/i || # artist folder + $trackartist =~ /\Q$artist\E/i))) { # track artist + next; + } + } + + # Set the album to misc if needed + if (!$trackalbum) { + $trackalbum = 'Miscellany'; + } + + # Match Album Title + if ($album) { + unless (($exact && # want exact match + ($trackalbum =~ /^\Q$album\E\//i || + $album =~ /^\Q$trackalbum\E(\/|$)/i)) # allow subfolders and parents + || + (!$exact && # not exact + $trackalbum =~ /\Q$album\E/i)) { + next; + } + } + + # Match Dates + + if (($dateFrom || $dateTo)) { + if (defined $year && (($dateFrom && $year < $dateFrom ) + || ($dateTo && $year > $dateTo ))) { + next; + } + } + + # Store Result + if ($searchFor eq 'artist') { + if ($folder) { + foreach (@CUSTOM) { + $folder = undef if (/^$folder$/) + } + if ($folder && + !($trackartist + && $scope eq 'misc')) {push(@result, makeABC($folder))} + } + if ($trackartist && + $trackartist ne $folder && + !($scope eq 'album')) { push(@result, makeABC($trackartist)); } + } + elsif ($searchFor eq 'album') { + my $partalbum = $trackalbum; + while ($partalbum =~ s/(.*)\/.+/$1/) { + my $parentalbum = $1; my $parentyear; + if ($parentalbum =~ / \((\d{4})\)(\/|)/) { + $parentyear = $1; + } + push(@result, "$parentyear$delim$parentalbum$delim$platter"); + } + # misc is always merged + my $albumline = "$year$delim$trackalbum$delim"; + $albumline.=$platter unless ($trackalbum eq "Miscellany"); + push(@result, $albumline); + } + elsif ($searchFor eq 'track') { + push(@result, "$raw$delim$platter"); + } + } + close PLATTER; + } + } + # remove duplicates from artist and album searches + #print join ("\n", keys %ABCS); + + @result = removeDup(@result) if ($searchFor ne 'track'); + # take random selection of results + if ($random>0) { + my %done; + my @randomlist; + + if ($random > $#result+1) { + $random = $#result+1; + } + + while ($random > 0) { + my $index; + do { + $index = int(rand($#result+1)); + } while (exists $done{$index}); + push(@randomlist, $result[$index]); + $done{$index} = 1; + $random--; + } + return @randomlist; + } + else { + return @result; + } +} + +sub removeDup( @_ ) { + my @result = sort( @_ ); + + my $last; + my $i=0; + while ($i<=$#result) { + if ($last eq $result[$i]) { + splice @result, $i, 1; + } + else { + $last = $result[$i]; + $i++; + } + } + return @result; +} + +sub makeABC( @_ ) { + my ($entry) = @_; + $entry =~ s/^\W*//; + if ($ABCS{$entry}) { $entry = ucfirst($ABCS{$entry}.$delim.$entry); } + return $entry; +} diff --git a/cgi-bin/abcmanager.plx b/cgi-bin/abcmanager.plx new file mode 100644 index 0000000..409b822 --- /dev/null +++ b/cgi-bin/abcmanager.plx @@ -0,0 +1,33 @@ +#!c:/perl/bin/perl + +use CGI; +use strict; +use URI::Escape; +use HTML::Entities (); +use Globals; +use Globals qw($delim); + +my $QUERY = CGI::new(); +my $ACTION = $QUERY->param( "action" ); +my $ARTIST = makeNice($QUERY->param( "artist" )); +my $ABC = makeNice($QUERY->param( "abc" )); +my %ABCS = getABCs(); + +print ""; + +if ($ACTION eq "remove") { + delete $ABCS{$ARTIST}; + } +elsif ($ACTION eq "add") { + $ABCS{$ARTIST} = $ABC.".abc" + } + +print "\n"; + +open ( ABC, ">../inventory/abcs.txt" ); +my @abckeys = sort {uc($a) cmp uc($b)} keys %ABCS; +my $key; +foreach $key (@abckeys) { + print ABC $key.$delim.$ABCS{$key}."\n"; + } +close ABC; diff --git a/cgi-bin/artist.plx b/cgi-bin/artist.plx new file mode 100644 index 0000000..cb6ea29 --- /dev/null +++ b/cgi-bin/artist.plx @@ -0,0 +1,141 @@ +#!c:/perl/bin/perl + +use CGI; +use strict; +use Search; +use Globals; +use Globals qw($delim); +use Globals qw($debug); +use Globals qw(%PLATTERS); +use Globals qw($target); +use Globals qw($bgcolour); + +my $query = CGI::new(); +my $artist = $query->param( "name" ); +$artist =~ s/(The |)(.*?)(, The|)/$2/; +my $reqAlbum = $query->param( "album" ); +my $inv = $query->param( "inv" ); +my $target = $query->cookie("target"); +my $webpage; + +if ( $target =~ /narrow/ ) +{ + $webpage = openTemplate("artistNarrow"); +} +else +{ + $webpage = openTemplate("artist"); +} + +Search::setArtist($artist); +Search::searchFor('album'); +Search::setExact(1); +if (length $inv > 0) { Search::setInv(split(',', $inv)) } +else { Search::setInv(keys %PLATTERS) } + +my @albums = Search::go() unless !$artist; + +my $albumlist; +my $hasMisc; +my $init; +my $index; +my $albumcount; +my $countreport; +my $firstAlbum; +foreach( @albums ) { + my ($year, $album, $platter) = split($delim); + my $selected; + print "$year, $album, $platter\n" if ($debug); + my $link = 'search.plx?artist='.makeUnNice($artist).'&album='.makeUnNice($album). + '&exact=1&searchFor=track&inv='.$platter; + + if ($album =~ /^\Q$reqAlbum\E$/) { + $init = $link.'&output=album'; + $selected = ' selected'; $reqAlbum = 'found'; + } + + $albumcount++; + + if ($album =~ /^Miscellany$/) { + if (!$hasMisc) { + $index = $link.'&output=album'; + $hasMisc = 1; + } + } + else { + + $firstAlbum = $link.'&output=album' if (!$firstAlbum); + $albumlist .= "\n