summaryrefslogtreecommitdiff
path: root/cgi-bin
diff options
context:
space:
mode:
Diffstat (limited to 'cgi-bin')
-rw-r--r--cgi-bin/Globals.pm229
-rw-r--r--cgi-bin/Search.pm307
-rw-r--r--cgi-bin/abcmanager.plx33
-rw-r--r--cgi-bin/artist.plx141
-rw-r--r--cgi-bin/front.plx109
-rw-r--r--cgi-bin/hosts.plx45
-rw-r--r--cgi-bin/news.plx47
-rw-r--r--cgi-bin/playlists/album.pm197
-rw-r--r--cgi-bin/playlists/artistlist.pm78
-rw-r--r--cgi-bin/playlists/extm3u.pm36
-rw-r--r--cgi-bin/playlists/extpls.pm39
-rw-r--r--cgi-bin/playlists/extrmp.pm53
-rw-r--r--cgi-bin/playlists/extwvx.pm64
-rw-r--r--cgi-bin/playlists/playlist.pm33
-rw-r--r--cgi-bin/playlists/tracks.pm85
-rw-r--r--cgi-bin/search.plx127
-rw-r--r--cgi-bin/searchplugin.plx25
-rw-r--r--cgi-bin/servernews.plx72
-rw-r--r--cgi-bin/settings.plx92
-rw-r--r--cgi-bin/trawler.plx393
20 files changed, 2205 insertions, 0 deletions
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 (<CONF>) {
+ 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 ( <SERVERS> )
+{
+ 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 (<ABC>) {
+ 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> <i>$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( <FILE> )
+ {
+ $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 = <INV>) {
+ $tracks++ unless($line =~ /^http/);
+ }
+ $tracks = 0 if $tracks < 1;
+ close INV;
+ open (ARTIST, "../inventory/".$platter.".artist");
+ $artists++ while (<ARTIST>);
+ 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 (<ARTIST>) {
+ 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 (<PLATTER>) {
+ 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 "<html><head>";
+
+if ($ACTION eq "remove") {
+ delete $ABCS{$ARTIST};
+ }
+elsif ($ACTION eq "add") {
+ $ABCS{$ARTIST} = $ABC.".abc"
+ }
+
+print "</head><script>location.replace(document.referrer);</script></html>\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<option value=\"$link\&output=album\"$selected>".makeNice($album);
+
+ }
+}
+
+if ($hasMisc) {
+ $albumlist = "<option value=\"$index\">Info & Miscellany\n$albumlist";
+}
+else {
+ $index = '/platdoc/emptyAlbum.html' ;
+ if ($firstAlbum && !$init) {
+ $init = $firstAlbum;
+ }
+}
+$albumlist = "$albumlist\n<option value=\"search.plx?artist=".makeUnNice($artist)."&exact=1&searchFor=track&output=album\">Show all";
+
+if ($albumlist) {
+ $albumlist = '<select onChange="switchAlbum(this.options[this.selectedIndex].value)">">'.$albumlist."</select></br>";
+ $countreport = "$albumcount found";
+}
+else {
+ $countreport = "None";
+}
+
+$init = $index if (!$init);
+
+# abcmanager links
+my $rejig;
+my %ABCS = getABCs();
+my $thisabc = $ABCS{$artist};
+if ($artist =~ / / || defined $thisabc) {
+
+ $rejig = '<img src="/platdoc/img/editbutton.png" width=32 height=32 alt="Edit" align="left"><nobr><small>Currently indexed as <br><strong>';
+
+ if (defined $thisabc ) {
+ $thisabc =~ s/\.abc.*//;
+ $rejig .= makeHTML($thisabc).'</strong><br>'.
+ '<a href="abcmanager.plx?artist='.makeUnNice($artist).'&action=remove">Clear</a></small></nobr>';
+ }
+ else {
+ my $newabc = $artist;
+ $newabc =~ s/(.*) (.*?)$/$2 $1/;
+ $rejig .= makeHTML($artist).'</strong><br>'.
+ '<a href="abcmanager.plx?artist='.makeUnNice($artist).'&abc='.makeUnNice($newabc).'&action=add">Index as '.makeHTML($newabc).'</a></small></nobr>';
+ }
+}
+$webpage =~ s/%INDEX%/$index/g;
+$webpage =~ s/%SECTIONS%/$albumlist/g;
+$webpage =~ s/%COUNT%/$countreport/g;
+$webpage =~ s/%ABC%/$rejig/g;
+
+$init =~ s/'/\\'/g;
+$webpage =~ s/%INIT%/$init/g;
+
+$webpage =~ s/%ARTIST%/$artist/g;
+
+my $urlartist = makeUnNice($artist);
+$webpage =~ s/%URLARTIST%/$urlartist/g;
+
+$artist =~ s/'/\\'/g;
+$webpage =~ s/%JSARTIST%/$artist/g;
+
+$webpage =~ s/%BGCOLOUR%/$bgcolour/g;
+
+print $webpage;
+
+
+
+
+
+
+
+
+
diff --git a/cgi-bin/front.plx b/cgi-bin/front.plx
new file mode 100644
index 0000000..6c64cc0
--- /dev/null
+++ b/cgi-bin/front.plx
@@ -0,0 +1,109 @@
+#!c:/perl/bin/perl
+
+use CGI;
+use Globals;
+use Globals qw(@CUSTOM);
+use Globals qw($VERSION);
+use Globals qw($target);
+use Globals qw($bgcolour);
+use strict;
+
+my $QUERY = CGI::new();
+
+my $WEBPAGE; # Source for the webpage will be written here
+my $CUSTOM;
+
+# Screw with the $target variable
+#
+$target =~ s/narrow/iframe/g;
+
+# Gather current user info
+#
+my $USER;
+my $HOST = $QUERY->remote_host();
+open USERS, "../data/users.txt" or die;
+while( <USERS> )
+{
+ if ( $_ =~ /$HOST/ )
+ {
+ chomp;
+ my @THISUSER = split (';');
+
+ $USER = "<b>$THISUSER[1]</b> ($THISUSER[0]/$THISUSER[2])";
+ }
+}
+close USERS;
+if (!defined $USER) { $USER = $HOST }
+
+# fill in custom folders
+
+foreach (@CUSTOM) {
+ my $folder = $_;
+ if ( length $CUSTOM > 0 )
+ {
+ $CUSTOM .= ", ";
+ }
+
+ $CUSTOM.='<a href="artist.plx?name='.makeUnNice($folder).'" target="'.$target.'"><b>'.$folder."</b></a>";
+}
+
+# decide the start page
+my $start;
+if (defined $QUERY->param('artist')) {
+ if (defined $QUERY->param('album')) {
+ $start="artist.plx?name=".makeUnNice($QUERY->param('artist'))."&album=".makeUnNice($QUERY->param('album'));
+ }
+ else
+ {
+ $start="search.plx?artist=".makeUnNice($QUERY->param('artist'))."&exact=0&searchFor=artist&output=tracks&filter=music,video,shortcut&scope=all";
+ }
+}
+else
+{
+ $start = "news.plx";
+ $start = "servernews.plx" if ($QUERY->cookie('start') eq 'servernews');
+}
+
+# load the headlines
+
+my $NEWS;
+if (open(NEWS, '../data/news.txt')) {
+ while(<NEWS>) {
+ chomp;
+ if (/^\[*(.*)\]$/) {
+ $NEWS .= ', ' if ($NEWS);
+ $NEWS.= '<a href="news.plx#'.$1.'" target="iframe">'.$1.'</a>';
+ }
+ }
+}
+
+# put the iframe in if we're not small screen
+my $iframe = '';
+if ($target ne '_top') {
+ $iframe = '<iframe src="%START%" name="iframe" id="iframe" width="100%" height="100%" frameborder="0"></iframe>';
+}
+
+# open the template file
+#
+$WEBPAGE = openTemplate("front");
+
+# Put in what we know
+#
+$WEBPAGE =~ s/%IFRAME%/$iframe/g;
+$WEBPAGE =~ s/%TARGET%/$target/g;
+$WEBPAGE =~ s/%VERSION%/$VERSION/g;
+$WEBPAGE =~ s/%USER%/$USER/g;
+$WEBPAGE =~ s/%HOST%/$HOST/g;
+$WEBPAGE =~ s/%CUSTOM%/$CUSTOM/g;
+$WEBPAGE =~ s/%START%/$start/g;
+$WEBPAGE =~ s/%HEADLINES%/$NEWS/g;
+$WEBPAGE =~ s/%BGCOLOUR%/$bgcolour/g;
+
+# Display the finished Web page
+#
+print $WEBPAGE;
+
+# Fin
+#
+close TEMPLATE;
+exit;
diff --git a/cgi-bin/hosts.plx b/cgi-bin/hosts.plx
new file mode 100644
index 0000000..a37cc41
--- /dev/null
+++ b/cgi-bin/hosts.plx
@@ -0,0 +1,45 @@
+#!c:/perl/bin/perl
+
+# UNIX shebang line
+#
+#!/usr/local/bin/perl -w
+
+# Use me
+#
+use CGI;
+use strict;
+use Globals;
+use Globals qw($bgcolour);
+my $counter = 0;
+
+my $WEBPAGE;
+my $SERVERS;
+my $USERS;
+
+# Start the page.
+#
+open TEMPLATE, "../templates/hosts.template" or die;
+
+while ( <TEMPLATE> )
+{
+ $WEBPAGE .= $_;
+}
+
+# Build a list of hosts and IPs
+#
+open (USERFILE, "../data/users.txt");
+
+while (<USERFILE>)
+{
+ chomp;
+ my @thisuser = split(';');
+
+ $USERS .= "<tr><td><span style=\"color:white;font-weight:bold;\">$thisuser[1]</span></td><td>$thisuser[0]</td><td>$thisuser[2]</td></tr>";
+}
+close( HOSTFILE );
+
+$WEBPAGE =~ s/%USERLIST%/$USERS/g;
+$WEBPAGE =~ s/%BGCOLOUR%/$bgcolour/g;
+
+print $WEBPAGE;
+exit;
diff --git a/cgi-bin/news.plx b/cgi-bin/news.plx
new file mode 100644
index 0000000..cf42681
--- /dev/null
+++ b/cgi-bin/news.plx
@@ -0,0 +1,47 @@
+#!c:/perl/bin/perl
+
+use CGI;
+use strict;
+use Globals;
+use Globals qw($audioRocketman);
+use Globals qw($videoRocketman);
+use Globals qw($bgcolour);
+
+my $WEBPAGE; # Source for the webpage will be written here
+
+# get the template
+#
+$WEBPAGE = openTemplate("news");
+
+# get news
+
+my $NEWS;
+my $SHATNER;
+if (open(NEWS, '../data/news.txt')) {
+ $SHATNER = <NEWS>;
+ while(<NEWS>) {
+ chomp;
+ if (/^\[*(.*)\]$/) {
+ $NEWS.="<p><b>".$1."</b><a name=\"".$1."\">&nbsp;</a><br>\n";
+ }
+ else {
+ $NEWS.=$_;
+ }
+ }
+}
+
+# Put in what we know
+#
+$WEBPAGE =~ s/%AUDROCKET%/$audioRocketman/g;
+$WEBPAGE =~ s/%VIDROCKET%/$videoRocketman/g;
+$WEBPAGE =~ s/%SHATNER%/$SHATNER/g;
+$WEBPAGE =~ s/%NEWS%/$NEWS/g;
+$WEBPAGE =~ s/%BGCOLOUR%/$bgcolour/g;
+
+# Display the finished Web page
+#
+print $WEBPAGE;
+
+# Fin
+#
+exit;
diff --git a/cgi-bin/playlists/album.pm b/cgi-bin/playlists/album.pm
new file mode 100644
index 0000000..89f9273
--- /dev/null
+++ b/cgi-bin/playlists/album.pm
@@ -0,0 +1,197 @@
+package album;
+
+use Globals;
+use CGI;
+use Globals qw(%PLATTERS);
+use Globals qw(@CUSTOM);
+use Globals qw($delim);
+use strict;
+
+sub new {
+ my $self = {
+ mime => "text/html",
+ playlist => undef,
+ artist => undef,
+ coverCount => 0,
+ info => undef,
+ platter => undef,
+ currentAlbum => undef,
+ playlink => undef,
+ custom => undef,
+ foreign => undef
+ };
+
+ my $query = CGI::new();
+ my $target = $query->cookie("target");
+
+ if ( $target =~ /narrow/ )
+ {
+ $self->{playlist} = openTemplate("albumNarrow");
+ }
+ else
+ {
+ $self->{playlist} = openTemplate("album");
+ }
+
+ bless ($self);
+ return $self;
+}
+
+sub desc {
+ return "Used internally to build album views";
+ }
+
+sub header {
+ my $self = shift;
+ my ($artist, $album) = @_;
+ $self->{artist} = $artist;
+ $self->{album} = $album;
+ #print $artist;
+ foreach ( @CUSTOM ) {
+ if ($artist eq $_) {
+ $self->{custom} = 1;
+ last;
+ }
+ }
+ # make a nice display for the albums
+ $album =~ /(\d{2} - |)(.*?)( \((\d{4})\)|)$/;
+ my $albumname = $2; my $year = $4;
+ my $htmlalbum = '<a href="front.plx?artist='.makeUnNice($artist).'&album='.makeUnNice($album).'" class="heading" target="_top" title="Platter link to '.$album.'"><span class="title">'.makeHTML($2).'</span></a>';
+ $htmlalbum = '' if ($albumname eq 'Miscellany');
+
+ # initialise the playlist
+ $self->{playlist} =~ s/%ALBUM%/$album/g;
+ $self->{playlist} =~ s/%HTMLALBUM%/$htmlalbum/g;
+ $self->{playlist} =~ s/%ARTIST%/$artist/g;
+ $self->{playlist} =~ s/%YEAR%/<br>&nbsp;<b>$year<\/b>/g;
+ $self->{playlink} = 'search.plx?artist='.makeUnNice($artist).'&album='.makeUnNice($album).'&exact=1&searchFor=track&inv=%INV%&filter=music,video,shortcut';
+ $self->{currentAlbum} = makeNice($album);
+
+}
+
+sub track {
+ my $self = shift;
+ my ($folder, $trackartist, $album, $year, $track, $url, $platter) = @_;
+
+ if ($track =~ /(cover|artist).*\.(gif|jpg|png)$/i) {
+ # put the image and label in if not there yet
+ if (!($self->{coverCount})) {
+ my $cover = '<p><a href="javascript:nextCover()"><img border=0 name="cover" id="cover" alt="Click for next image"></a><br>'.
+ '<small>Image from <strong name="coversource" id="coversource">Nobody</strong>&nbsp;(<span name="coverno" id="coverno">0</span> of %TOTALCOVERS%)</small><script>nextCover();</script>';
+
+ $self->{playlist} =~ s/%COVER%/$cover/;
+ }
+
+ # insert into the javascript arrays
+
+ my $coverLoc = "locations[$self->{coverCount}] = '".makeJs('http://'.$PLATTERS{$platter}.$url)."';\n ";
+ $self->{playlist} =~ s/%LOCATIONS%/$coverLoc%LOCATIONS%/;
+ my $coverSource = "sources[$self->{coverCount}] = '$platter';\n ";
+ $self->{playlist} =~ s/%SOURCES%/$coverSource%SOURCES%/;
+
+ $self->{coverCount}++;
+
+ }
+ elsif ($track =~ /info\.txt$/i) {
+ $self->{info} .= '<p><i>'.$platter.' says:</i><br>'.getFile('http://'.$PLATTERS{$platter}.$url)."\n";
+ }
+ else { # add the track
+
+ # look to see if we're on a child album and report it
+ my $trackhtml;
+ my $nicealbum = makeNice($album);
+
+ if ($self->{currentAlbum} ne $nicealbum) {
+ my $albumstub = $nicealbum;
+ $albumstub =~ s/^\Q$self->{album}\E\///;
+ $trackhtml = '<br><b>'.makeHTML($albumstub)."</b>\n";
+ }
+
+ $self->{currentAlbum} = $nicealbum;
+
+ # link to other folder if present
+ my $foreigner;
+ foreach (($folder, $trackartist)) {
+ my $thisArtist = $_;
+ my $thisNiceArtist = makeNice($thisArtist);
+ if ($thisArtist && !($thisNiceArtist =~ /^$self->{artist}$/i) && !($thisNiceArtist =~ /^$folder$/i) ) {
+ $foreigner = '<br><small><i>';
+ $foreigner .= 'with ' if (!$self->{custom});
+ $foreigner .= '<a href="artist.plx?name='.makeUnNice($thisArtist).'&exact=1" target="_parent">'.makeHTML($thisArtist).'</a></i></small>' ;
+ }
+ }
+
+ # paste the track in
+ $trackhtml .= '<li><a href="'.makeTrackURL($PLATTERS{$platter}, $url, $folder, $trackartist, $track ).'"><img src="/platdoc/img/filebutton_s.png" border=0 align="top"></a><a href="'.makeTrackPlaylist($folder, $trackartist, $album, $track, $platter).'"><img src="/platdoc/img/playbutton_s.png" border=0 align="top"> '.makeHTML($track)."</a>$foreigner</li>\n%TRACKS%";
+
+ $self->{playlist} =~ s/%TRACKS%/$trackhtml/;
+
+ # check if extract of another album
+ if (!$self->{foreign} && $self->{album} ne 'Miscellany') {
+ my $artistlink = makeNice($folder);
+ if ($artistlink && $artistlink ne $self->{artist}) { # link to proper artist page
+ $self->{foreign} = "&nbsp;<i>from <a href=\"artist.plx?name=".makeUnNice($artistlink)."&album=".$album."\" target=\"_parent\">$artistlink</a>";
+ }
+ else {
+ $self->{foreign} = " "; # don't check again
+ }
+ }
+
+ # update the host
+ if ($self->{platter} eq "") {
+ $self->{platter} = $platter;
+ }
+ elsif ($self->{platter} ne $platter && $self->{platter} ne 'Various') {
+ $self->{platter} = 'Various';
+ }
+
+ }
+}
+
+sub dump {
+ my $self = shift;
+ # remove any unused placeholders
+ $self->{playlist} =~ s/%COVER%//;
+ $self->{playlist} =~ s/%TRACKS%//;
+ $self->{playlist} =~ s/%SOURCES%//;
+ $self->{playlist} =~ s/%LOCATIONS%//;
+ $self->{playlist} =~ s/%TOTALCOVERS%/$self->{coverCount}/g;
+
+ # info
+ my $info = $self->{info};
+ my $infolink;
+ if (!$info) {
+ $info = '<p><i>No further info available</i>' ;
+ }
+ else {
+ $infolink = '<a href="#info"><img src="/platdoc/img/infobutton.png" width=32 height=32 border=0 alt="Information"></a>';
+ }
+
+ my $playbutton; my $hostreport;
+
+ # playbutton
+ if ($self->{platter}) {
+ $playbutton = '<a href="'.$self->{playlink}.'">'.
+ '<img src="/platdoc/img/playbutton.png" width=32 height=32 border=0 alt="Play"></a>';
+ $hostreport = 'Hosted by <strong>%SOURCE%</strong>';
+ }
+ $self->{playlist} =~ s/%PLAYBUTTON%/$playbutton/;
+ $self->{playlist} =~ s/%HOST%/$hostreport/;
+
+
+ #all other vars
+ my $source = $self->{platter};
+ $self->{playlist} =~ s/%SOURCE%/$source/;
+
+ $source = '' if ($source eq 'Various');
+ $self->{playlist} =~ s/%INV%/$source/;
+
+ $self->{playlist} =~ s/%INFO%/$info/;
+ $self->{playlist} =~ s/%INFOBUTTON%/$infolink/;
+
+ my $link = $self->{foreign};
+ $self->{playlist} =~ s/%FOREIGN%/$link/;
+ return $self->{playlist};
+ }
+
+return 1;
diff --git a/cgi-bin/playlists/artistlist.pm b/cgi-bin/playlists/artistlist.pm
new file mode 100644
index 0000000..5c419c7
--- /dev/null
+++ b/cgi-bin/playlists/artistlist.pm
@@ -0,0 +1,78 @@
+package artistlist;
+
+use strict;
+use Globals;
+use Globals qw(%PLATTERS);
+use Globals qw(@MUSIC);
+use Globals qw(@VIDEO);
+use Globals qw($target);
+use Globals qw($delim);
+use Globals qw($bgcolour);
+
+sub new {
+ my $self = {
+ mime => "text/html",
+ playlist => openTemplate("search"),
+ artistSearch => 0,
+ section => undef,
+ shortcuts => '<br>',
+ count => 0};
+
+ # show the logo if this is a new page
+ my $logo;
+ $logo = '<a href="front.plx"><img src="/platdoc/img/logo.gif" hspace=0 border=0></a>' if ($target eq '_top');
+ $self->{playlist} =~ s/%LOGO%/$logo/;
+ $self->{playlist} =~ s/%BGCOLOUR%/$bgcolour/;
+
+ bless ($self);
+ return $self;
+}
+
+sub desc {
+ return "Artist Search Results";
+ }
+
+sub header {
+ my $self = shift;
+}
+
+sub track {
+ my ($self, $abc, $artist) = @_;
+ $artist = $abc if !$artist;
+ my $firstletter = substr($abc, 0, 1);
+ if ($firstletter ne $self->{section}) {
+ $self->{playlist} .= '<hr style="color:white; clear:both" align="left">' if ($self->{section});
+ $self->{playlist} .= '<span class="title">'.$firstletter."</span><a name=\"".uc($firstletter)."\">\n</a><p>";
+ $self->{section} = $firstletter;
+ $self->{shortcuts} .= '<a href="#'.$firstletter.'"><b>'.$firstletter.'</b></a>&nbsp;';
+ }
+ my $realength = $artist;
+ $realength=~s/&[^;]*;/x/g;
+ $realength = (int(length($realength) / 20) +1)*120;
+ $self->{playlist} .= "<div style=\"float:left; width:".$realength."px\">".
+ "<a href=\"artist.plx?name=".makeUnNice($artist)."&exact=1\">".makeHTML($artist)."</a>&nbsp;</div>";
+ $self->{count}++;
+}
+
+sub dump {
+ my $self = shift;
+ $self->{playlist} .= "\n<br style=\"clear:both\">";
+ my $shortcuts = $self->{shortcuts};
+ $self->{playlist} =~ s/%SHORTCUTS%/$shortcuts/;
+
+ if ($self->{count} > 0)
+ {
+ my $REPORT = "Found ".$self->{count}." artists.";
+ $self->{playlist} =~ s/%COUNT%/$REPORT/;
+ return $self->{playlist}."</ol><p>$REPORT</body></html>";
+ }
+ else
+ {
+ $self->{playlist} =~ s/%COUNT%/<p>Sorry, no-one found./;
+
+ return $self->{playlist}."</ol></body></html>";
+ }
+}
+
+return 1;
+
diff --git a/cgi-bin/playlists/extm3u.pm b/cgi-bin/playlists/extm3u.pm
new file mode 100644
index 0000000..01d7eee
--- /dev/null
+++ b/cgi-bin/playlists/extm3u.pm
@@ -0,0 +1,36 @@
+package extm3u;
+
+use Globals;
+use Globals qw(%PLATTERS);
+use strict;
+use Globals qw($delim);
+
+sub new {
+ my $self = {
+ mime => "audio/x-mpegurl",
+ playlist => "#EXTM3U\n" };
+ bless ($self);
+ return $self;
+}
+
+sub desc {
+ return "Standard format for mp3 playlists";
+ }
+
+sub header {
+}
+
+sub track {
+ my $self = shift;
+ my ($folder, $trackartist, $album, $year, $track, $url, $platter) = @_;
+ my $artist = getArtistString($folder, $trackartist);
+ $self->{playlist} .=
+ "#EXTINF:180,".makeNice($artist)." - ".makeNice($track)."\n".makeTrackURL( $PLATTERS{$platter}, $url, $folder, $trackartist, $track )."\n";
+ }
+
+sub dump {
+ my $self = shift;
+ return $self->{playlist};
+ }
+
+return 1;
diff --git a/cgi-bin/playlists/extpls.pm b/cgi-bin/playlists/extpls.pm
new file mode 100644
index 0000000..9cc048c
--- /dev/null
+++ b/cgi-bin/playlists/extpls.pm
@@ -0,0 +1,39 @@
+package extpls;
+
+use strict;
+use Globals;
+use Globals qw(%PLATTERS);
+use Globals qw($delim);
+
+sub new {
+ my $self = {
+ mime => "audio/scpls",
+ playlist => "[playlist]\n",
+ count => 0};
+ bless ($self);
+ return $self;
+}
+
+sub desc {
+ return "Very common audio playlist format";
+}
+
+sub header {
+}
+
+sub track {
+ my $self = shift;
+ my ($folder, $trackartist, $album, $year, $track, $url, $platter) = @_;
+ my $artist = getArtistString($folder, $trackartist);
+ $self->{count}++;
+ $self->{playlist} .= "File".$self->{count}."=".makeTrackURL( $PLATTERS{$platter}, $url, $folder, $trackartist, $track )."\n".
+ "Title".$self->{count}."=".makeNice($track)."\n".
+ "Length".$self->{count}."=-1\n";
+ }
+
+sub dump {
+ my $self = shift;
+ return $self->{playlist}."NumberOfEntries=".$self->{count}."\nVersion=2\n";
+ }
+
+return 1;
diff --git a/cgi-bin/playlists/extrmp.pm b/cgi-bin/playlists/extrmp.pm
new file mode 100644
index 0000000..f17eb82
--- /dev/null
+++ b/cgi-bin/playlists/extrmp.pm
@@ -0,0 +1,53 @@
+package extrmp;
+
+use strict;
+use Globals;
+use Globals qw(%PLATTERS);
+use Globals qw($delim);
+
+sub new {
+ my $self = {
+ mime => "application/vnd.rn-rn_music_package",
+ playlist => "<PACKAGE>\n".
+ "<ACTION>import,play,replace</ACTION>\n".
+ '<SERVER><LOCATION>%f</LOCATION></SERVER>',
+ count => 0};
+ bless ($self);
+ return $self;
+}
+
+sub desc {
+ return "RealOne Player";
+ }
+
+sub header {
+ my $self = shift;
+ my ($artist, $album) = @_;
+ $self->{playlist} .= "<TITLE>".makeNice($album)."</TITLE>".
+ "<SERVER><LOCATION>%f</LOCATION></SERVER>".
+ "<TARGET>".makeNice($album)."</TARGET>".
+ "<TRACKLIST>\n";
+
+}
+
+sub track {
+ my $self = shift;
+ my ($folder, $trackartist, $album, $year, $track, $url, $platter) = @_;
+ my $artist = getArtistString($folder, $trackartist);
+ $self->{count}++;
+ $self->{playlist} .= "<TRACK>\n".
+ "<TRACKID>".$self->{count}."</TRACKID>\n".
+ "<TITLE>".makeNice($track)."</TITLE>\n".
+ "<ARTIST>".makeNice($artist)."</ARTIST>\n".
+ "<ALBUM>".makeNice($album)."</ALBUM>\n".
+ "<FILENAME>".makeTrackURL( $PLATTERS{$platter}, $url, $folder, $trackartist, $track )."</FILENAME>\n".
+ "</TRACK>\n";
+
+ }
+
+sub dump {
+ my $self = shift;
+ return $self->{playlist}."</TRACKLIST></PACKAGE>";
+ }
+
+return 1;
diff --git a/cgi-bin/playlists/extwvx.pm b/cgi-bin/playlists/extwvx.pm
new file mode 100644
index 0000000..7decaee
--- /dev/null
+++ b/cgi-bin/playlists/extwvx.pm
@@ -0,0 +1,64 @@
+package extwvx;
+
+use strict;
+
+use Globals;
+use Globals qw($CGIROOT);
+use Globals qw($APPNAME);
+use Globals qw(%PLATTERS);
+use Globals qw($delim);
+use Globals qw(@VIDEO);
+
+sub new {
+ my $self = {
+ mime => "video/x-ms-wvx",
+ playlist => "<Asx Version = \"3.0\" >\n"};
+ bless ($self);
+ return $self;
+}
+
+sub desc {
+ return "Windows Media Player Playlist";
+ }
+
+sub header {
+ my $self = shift;
+ my ($artist, $album) = @_;
+ $album =~ /(\d{2} - |)(.*)(\((\d{4})\)|)/;
+ $self->{playlist} .= "<Title>$2</Title>".
+ "<Author>$artist</Author>".
+ "<Param Name = \"AllowShuffle\" Value = \"yes\" />\n";
+}
+
+sub track {
+ my $self = shift;
+
+ my ($folder, $trackartist, $album, $year, $track, $url, $platter) = @_;
+ my $artist = getArtistString($folder, $trackartist);
+
+ my $mediatype = "audio";
+ $track =~ /.*\.(.*?)/i;
+ my $filetype = $1;
+ foreach (@VIDEO) {
+ $mediatype = "video" if (/^$filetype$/i);
+ }
+
+ $self->{playlist} .= "<Entry>\n".
+ "<Title>".makeNice($track)."</Title>\n".
+ "<Ref href = \"".makeTrackURL( $PLATTERS{$platter}, $url, $folder, $trackartist, $track )."\"/>\n".
+ "<Param Name = \"Artist\" Value = \"".$artist."\" />\n".
+ "<Param Name = \"Album\" Value = \"".makeNice($album)."\" />\n".
+ "<Param Name = \"MediaType\" Value = \"".$mediatype."\" />\n".
+ "<Banner Href = \"http://$CGIROOT/platdoc/img/banner.png\">\n".
+ "<Abstract>Click to go to the ".makeNice($folder)." page</Abstract>\n".
+ "<Moreinfo Href=\"http://$CGIROOT/$APPNAME/front.plx?artist=".makeUnNice($folder)."&album=".makeUnNice($album)."\" />\n".
+ "</Banner>\n".
+ "</Entry>\n";
+ }
+
+sub dump {
+ my $self = shift;
+ return $self->{playlist}."</Asx>";
+ }
+
+return 1;
diff --git a/cgi-bin/playlists/playlist.pm b/cgi-bin/playlists/playlist.pm
new file mode 100644
index 0000000..5ee280e
--- /dev/null
+++ b/cgi-bin/playlists/playlist.pm
@@ -0,0 +1,33 @@
+package playlist;
+use strict;
+use Globals;
+
+return 1;
+
+sub new {
+ my ($proto, $playlist) = @_;
+ my $playlister = eval("use playlists::".$playlist."; ".$playlist."->new();");
+ if (!defined $playlister) {
+ $playlister = {
+ mime => "text/html",
+ playlist => openTemplate("error"),
+ };
+ $playlister->{playlist} =~ s/%NAME%/$playlist/g;
+ bless ($playlister);
+ }
+
+ return $playlister;
+}
+
+sub desc { return "Not Currently Working"; }
+
+sub header {
+ }
+
+sub track {
+ }
+
+sub dump {
+ my $self = shift;
+ return $self->{playlist};
+ }
diff --git a/cgi-bin/playlists/tracks.pm b/cgi-bin/playlists/tracks.pm
new file mode 100644
index 0000000..5e73766
--- /dev/null
+++ b/cgi-bin/playlists/tracks.pm
@@ -0,0 +1,85 @@
+package tracks;
+
+use strict;
+use Globals;
+use Globals qw(%PLATTERS);
+use Globals qw(@MUSIC);
+use Globals qw(@VIDEO);
+use Globals qw($target);
+use Globals qw($delim);
+use Globals qw($bgcolour);
+
+sub new {
+ my $self = {
+ mime => "text/html",
+ playlist => openTemplate("search"),
+ artistSearch => 0,
+ count => 0};
+
+ # show the logo if this is a new page
+ my $logo;
+ $logo = '<a href="front.plx"><img src="/platdoc/img/logo.gif" hspace=0 border=0></a>' if ($target eq '_top');
+ $self->{playlist} =~ s/%LOGO%/$logo/;
+ $self->{playlist} =~ s/%BGCOLOUR%/$bgcolour/g;
+
+ bless ($self);
+ return $self;
+}
+
+sub desc {
+ return "Track Search Results";
+ }
+
+sub header {
+ my $self = shift;
+ $self->{playlist} .= '<ol>';
+}
+
+sub track {
+ my $self = shift;
+ my ($folder, $trackartist, $album, $year, $track, $url, $platter) = @_;
+
+ $self->{count}++;
+
+ $self->{playlist} .= "<li>";
+
+ #prepare urls
+
+ $self->{playlist} .= '<a href="'.makeTrackURL($PLATTERS{$platter}, $url, $folder, $trackartist, $track ).'"><img src="/platdoc/img/filebutton_s.png" border=0 align="middle"></a><a href="'.makeTrackPlaylist($folder, $trackartist, $album, $track, $platter).'"><img src="/platdoc/img/playbutton_s.png" border=0 align="middle"> &quot;'.makeHTML($track)."</a>&quot;<br>";
+
+ # prepare artist info
+ foreach( ($folder, $trackartist) ) {
+
+ $self->{playlist} .= "<a href=\"artist.plx?name=".makeUnNice($_)."&exact=1\">".makeHTML($_)."</a>," if (/.+/);
+ }
+ chop $self->{playlist}; # remove trailing comma
+
+ if (length $album > 0) { # album
+ $self->{playlist} .= "<br>from <a href=\"artist.plx?name=".makeUnNice($folder)."&album=".makeUnNice($album)."&exact=1\">";
+ $album =~ s/\(\d{4}\)(\/|$)/$1/;
+ $self->{playlist} .= makeHTML($album)."</a>";
+ if ($year > 0) { $self->{playlist} .= " <small>($year)</small>" }
+ }
+
+ $self->{playlist} .= "<span style=\"font-size:4pt;\"><br>&nbsp;</span></li>\n";
+}
+
+sub dump {
+ my $self = shift;
+ $self->{playlist} =~ s/%SHORTCUTS%//;
+ if ($self->{count} > 0)
+ {
+ my $REPORT = "Found ".$self->{count}." matches.";
+ $self->{playlist} =~ s/%COUNT%/$REPORT/;
+ return $self->{playlist}."</ol><p>$REPORT</body></html>";
+ }
+ else
+ {
+ $self->{playlist} =~ s/%COUNT%/<p>Sorry, nothing found./;
+
+ return $self->{playlist}."</ol></body></html>";
+ }
+}
+
+return 1;
+
diff --git a/cgi-bin/search.plx b/cgi-bin/search.plx
new file mode 100644
index 0000000..ce1513a
--- /dev/null
+++ b/cgi-bin/search.plx
@@ -0,0 +1,127 @@
+#!c:/perl/bin/perl
+
+# UNIX shebang line
+#
+#!/usr/local/bin/perl -w
+
+# Use me
+#
+use CGI;
+use strict;
+use Globals;
+use Globals qw(%PLATTERS);
+use Globals qw(@MUSIC);
+use Globals qw(@VIDEO);
+use Globals qw(@SHORTCUT);
+use Globals qw($delim);
+use Globals qw($debug);
+use playlists::playlist;
+use Search;
+
+my $QUERY = CGI::new();
+my $artist = $QUERY->param( "artist" );
+my $title = $QUERY->param( "title" );
+my $album = $QUERY->param( "album" );
+my $dateFrom = $QUERY->param( "dateFrom" );
+my $dateTo = $QUERY->param( "dateTo" );
+my $scope = $QUERY->param( "scope" );
+my $random = $QUERY->param( "random" );
+my $output = $QUERY->param( "output" );
+my $filter = $QUERY->param( "filter" );
+my $exact = $QUERY->param( "exact" );
+my $inv = $QUERY->param( "inv" );
+my $searchFor = $QUERY->param( "searchFor" );
+
+$searchFor = 'track' unless ($searchFor);
+
+# platter shortcut here
+if ($output eq 'redir') {
+ $searchFor = 'track';
+ $filter = 'music,video';
+ $random = 1; # in case the search returns more than one track
+}
+
+
+# fill in search params
+
+Search::setArtist($artist);
+Search::setTitle($title);
+Search::setAlbum($album);
+Search::setDateFrom($dateFrom);
+Search::setDateTo($dateTo);
+Search::setScope($scope);
+Search::setExact($exact);
+Search::setRandom($random);
+Search::searchFor($searchFor);
+
+# set inventories
+my @invs = split(',', $inv);
+if (scalar(@invs) == 0) {
+ @invs = keys %PLATTERS;
+}
+Search::setInv(@invs);
+
+# find the right file filters
+my @filters = split(',', $filter);
+my @allfilters = ();
+foreach (@filters) {
+ tr/a-z/A-Z/;
+ my @newfilter = eval("@".$_.";");
+ push (@allfilters, @newfilter);
+}
+
+Search::setFilter(@allfilters);
+my $exclTypes = $QUERY->cookie('exclTypes');
+Search::setExclTypes($exclTypes);
+
+my @result = Search::go();
+
+# redirect when there is only one match
+if ($searchFor eq 'artist' && scalar(@result)==1) { # Exact match
+ $result[0] = substr( $result[0], rindex( $result[0] , $delim)+1); # chop off the abc if there
+ print "HTTP/1.0 302 Found\nLocation: artist.plx?name=".makeUnNice($result[0])."&exact=1\nContent-Type:text/html\n\n";
+ exit;
+}
+
+# redirect platter shortcuts
+if ($output eq 'redir') {
+ if (length($result[0]) == 0) { print "HTTP/1.0 404 Not Found\n\n"; exit; }
+ my ($folder, $trackartist, $album, $year, $track, $url, $platter) = split($delim, $result[0]);
+ print "HTTP/1.0 302 Found\nLocation: http://".$PLATTERS{$platter}.$url."\nContent-Type:text/html\n\n";
+ exit;
+
+}
+
+# artist searches must return an artistlist
+if ($searchFor eq 'artist') {
+ $output = 'artistlist';
+}
+
+# if the output format was not specified, get the playlist format from the cookie
+if (length $output == 0) {
+ my $cookie = $QUERY->cookie("format");
+ if (length $cookie == 0) { # default to m3u
+ $cookie = 'extm3u';
+ }
+ $output = $cookie;
+}
+
+my $playlist = playlist->new($output);
+
+unless ($artist) { $artist = "Various" }
+if ($title && !$album) {$album = makeNice($title) }
+if ($random > 0) { $album = "Random ".$album }
+$playlist->header($artist, $album);
+
+foreach( @result) {
+ my @line = split($delim);
+ #print join(',', @line)."\n" if ($debug);
+ $playlist->track(@line);
+}
+
+print "HTTP/1.0 200 OK\nContent-type: ".$playlist->{mime}."\n";
+if ($playlist->{mime} ne "text/html" && $output =~ /^ext(.*)/) {
+ print "Content-Disposition: attachment; filename=\"$artist - $album.$1\";\n";
+ }
+print "\n";
+print $playlist->dump();
diff --git a/cgi-bin/searchplugin.plx b/cgi-bin/searchplugin.plx
new file mode 100644
index 0000000..01ff41f
--- /dev/null
+++ b/cgi-bin/searchplugin.plx
@@ -0,0 +1,25 @@
+# Use me
+#
+use CGI;
+use strict;
+use Globals;
+use Globals qw($CGIROOT);
+use Globals qw($APPNAME);
+
+my $WEBPAGE;
+
+# Start the page.
+#
+open TEMPLATE, "../templates/searchplugin.template" or die;
+
+while ( <TEMPLATE> )
+{
+ $WEBPAGE .= $_;
+}
+
+
+$WEBPAGE =~ s/%CGIROOT%/$CGIROOT/g;
+$WEBPAGE =~ s/%APPNAME%/$APPNAME/g;
+
+print $WEBPAGE;
+exit;
diff --git a/cgi-bin/servernews.plx b/cgi-bin/servernews.plx
new file mode 100644
index 0000000..d7ae9ce
--- /dev/null
+++ b/cgi-bin/servernews.plx
@@ -0,0 +1,72 @@
+#!c:/perl/bin/perl
+
+use CGI;
+use strict;
+use Globals;
+use Globals qw(%ALLPLATTERS);
+use Globals qw($bgcolour);
+
+my $QUERY = CGI::new();
+my $exclude = $QUERY->cookie("exclude");
+my $emptytime = 0;
+my %servers;
+
+# Generate server exclusion form
+#
+my $server; my $totartists; my $tottracks;
+foreach $server ( keys %ALLPLATTERS )
+{
+ chomp $server;
+
+
+ my $newsfile = '../inventory/'.$server.".news";
+ my $thistime = $emptytime++;
+ my $thisnews = '<p><a href="search.plx?searchFor=artist&inv='.$server.'&output=artistlist"><b><i>'.$server.'</i></b></a><br>';
+ my ($tracks,$artists) = getPlatterStats($server);
+ $totartists+=$artists; $tottracks+=$tracks;
+ $thisnews .= '<small>'.$tracks.' tracks by '.$artists.' artists.<br>';
+ # open the news file
+ if (open NEWS, $newsfile) {
+ $thistime = <NEWS>; chomp $thistime;
+ $thisnews .= 'News last updated: '.localtime($thistime).' CET</small><br>';
+ while ( <NEWS> ) { $thisnews .= $_; }
+ close NEWS;
+ }
+ else {
+ # add to 'hidden' servers list
+ $thisnews .= 'No news found.</small><br>';
+ }
+ # check the box if it's a selected server
+ my $checked = 'checked';
+ if ($exclude =~ /$server/) { $checked = ''; }
+
+
+ # write the selection box
+ $thisnews.= '<br clear=left><small><input type="checkbox" name="'.$server.'" onClick="setServers()" '.$checked.'>Include <b><i>'.$server.'</i></b> in your selected servers.</small>';
+
+ $servers{ $thistime } = $thisnews;
+
+}
+
+my $serverlist = '<h5>Today the platter contains '.$tottracks.' tracks by '.$totartists.' artists</h5>';
+
+foreach (sort {$b <=> $a} keys %servers) {
+ $serverlist.= $servers{$_};
+}
+
+# get the template
+#
+my $WEBPAGE = openTemplate("servernews");
+
+# Put in what we know
+#
+$WEBPAGE =~ s/%SERVERS%/$serverlist/g;
+$WEBPAGE =~ s/%BGCOLOUR%/$bgcolour/g;
+
+# Display the finished Web page
+#
+print $WEBPAGE;
+
+# Fin
+#
+exit;
diff --git a/cgi-bin/settings.plx b/cgi-bin/settings.plx
new file mode 100644
index 0000000..dffc8cb
--- /dev/null
+++ b/cgi-bin/settings.plx
@@ -0,0 +1,92 @@
+#!c:/perl/bin/perl
+
+use strict;
+use Globals;
+use CGI;
+use playlists::playlist;
+use Globals qw(%ALLPLATTERS @MUSIC @VIDEO @SHORTCUT $bgcolour);
+
+# Scripting variables
+#
+my $WEBPAGE = openTemplate("settings");
+my $FORMATS;
+my $SERVERS;
+my $QUERY = CGI::new();
+my $exclude = $QUERY->cookie("exclude");
+my @AVAILABLE;
+
+# Playlist formats form
+opendir(DIR, "./playlists/");
+while (my $file = readdir(DIR)) {
+ if ($file =~ /^ext(.*)\.(pm)$/) {
+ push (@AVAILABLE, $1);
+ }
+ }
+closedir DIR;
+
+my $thisformat;
+my $desc;
+foreach ( @AVAILABLE ) {
+ if (/playlist/) { next }
+ $thisformat = $_;
+ $desc = playlist->new("ext$thisformat")->desc();
+ $FORMATS.="<tr valign=\"top\"><td><input type=\"radio\" name=\"playlist\" value=\"ext$thisformat\" ".
+ "onClick=\"setCookie('format', 'ext$thisformat'); \">".
+ "</td><td><b>$thisformat</b></td><td>$desc</td></tr>\n";
+}
+
+$WEBPAGE =~ s/%FORMATS%/$FORMATS/;
+$WEBPAGE =~ s/%BGCOLOUR%/$bgcolour/g;
+
+# filetype form
+
+my $query = CGI::new();
+my $currExts = $query->cookie('exclTypes');
+my $EXTS = createExtForm("Audio", $currExts, @MUSIC).createExtForm("Video", $currExts, @VIDEO).createExtForm("Shortcut", $currExts, @SHORTCUT);
+
+$WEBPAGE =~ s/%EXTS%/$EXTS/;
+
+# server exclusion form
+#
+
+foreach( keys %ALLPLATTERS )
+{
+ chomp;
+ my @THISSERVER = split;
+ my $CHECKED = 'checked';
+ if ($SERVERS =~ /"$THISSERVER[0]"/) { next;}
+ if ($exclude =~ /$THISSERVER[0]/)
+ {
+ $CHECKED = '';
+ }
+
+ $SERVERS.= '<input type="checkbox" name="'.$THISSERVER[0].'" onClick="setServers()" '.$CHECKED.'><a href="search.plx?searchFor=artist&inv='.$THISSERVER[0].
+ '&output=artistlist"><b><i>'.$THISSERVER[0].'</i></b></a><br>';
+}
+
+# Put in what we know
+#
+$WEBPAGE =~ s/%SERVERS%/$SERVERS/g;
+
+
+# Display the finished Web page
+#
+
+print $WEBPAGE;
+
+# Fin
+#
+close TEMPLATE;
+exit;
+
+sub createExtForm() {
+ my ($TITLE, $CURR, @EXTS) = @_;
+ my $FORM = "<br><strong>$TITLE:</strong>";
+ my $ext;
+ foreach $ext ( @EXTS ) {
+ my $CHECKED = ' checked';
+ $CHECKED = '' if ($CURR =~ /$ext,/);
+ $FORM.='&nbsp;<input type="checkbox" name="'.$ext.'" onClick="setExts()"'.$CHECKED."><b><i>$ext</i></b>&nbsp;\n";
+ }
+ return $FORM."\n";
+} \ No newline at end of file
diff --git a/cgi-bin/trawler.plx b/cgi-bin/trawler.plx
new file mode 100644
index 0000000..9d755d2
--- /dev/null
+++ b/cgi-bin/trawler.plx
@@ -0,0 +1,393 @@
+#!c:/perl/bin/perl
+
+use strict;
+use LWP::UserAgent;
+require LWP;
+use URI;
+use LWP::RobotUA;
+require LWP::RobotUA;
+use Globals;
+use Globals qw(%ALLPLATTERS);
+use Globals qw($MINTRAWL);
+use Globals qw($delim);
+use Globals qw(@MUSIC);
+use Globals qw(@VIDEO);
+use Globals qw(@SHORTCUT);
+use Globals qw($debug);
+use Globals qw($bgcolour);
+
+use CGI qw(:standard);
+$|=1;
+
+my $QUERY = CGI::new();
+my $NAMELIST = $QUERY->param( "hosts" );
+my $NAME;
+my $HOST;
+my $BASE;
+my %ABCS;
+my $HEADER = new HTTP::Headers( 'Accept' => 'text/plain', 'User-Agent' => 'PlatterTwaartter/3.0.0', 'Dixon' => 'Am-Hammy-Twaart' );
+my $ROBOT_NAME = "PlatterTwaartter";
+my $ROBOT_OWNER = "chris.dixon\@hammytwaart.com";
+my $USERAGENT;
+my $RECURSE=0; # Stop weird parent links setting us up the bomb
+my $LINECOUNT = 0;
+my $QUICKEXT = $delim.join($delim, (@MUSIC, @VIDEO, @SHORTCUT)).$delim;
+# Print the header
+#
+my $TEMPLATE = openTemplate ("trawl");
+$TEMPLATE =~ s/%MINTRAWL%/$MINTRAWL/g;
+$TEMPLATE =~ s/%BGCOLOUR%/$bgcolour/g;
+print $TEMPLATE;
+
+if ( defined $NAMELIST ) {
+
+ # Lock the inventory against meddling by pesky kids
+ if (-e "../inventory/trawl.lock") {
+ print '<p>The Distroplat inventory is currently locked by another user. Please <a href="javascript:location.reload()">try again</a> in a bit. Bye.</p>';
+ exit(0);
+ }
+
+ open (LOCK, ">../inventory/trawl.lock");
+ close(LOCK);
+
+ # Load the ABCs
+
+ %ABCS = getABCs();
+
+ #Set up the user agent
+
+ $USERAGENT = new LWP::RobotUA $ROBOT_NAME, $ROBOT_OWNER;
+ # go as fast as you can
+ $USERAGENT->delay(0);
+ $USERAGENT->timeout(15); # seconds - doesn't seem to work though
+
+ # Deal with each server in turn
+ my @SPLITNAME = split(',', $NAMELIST);
+
+ print "<h2>Attempting to trawl ".scalar(@SPLITNAME)." servers</h2>\n";
+
+ foreach $NAME (@SPLITNAME) {
+
+ print "<h4>Trawling $NAME . . </h4>";
+ open (INVENTORY, ">../inventory/$NAME.inv");
+ open (ARTISTS, ">../inventory/$NAME.artist");
+ # Find the host
+ my $found=0;
+ my @RESULT;
+ foreach $HOST (keys %ALLPLATTERS) {
+ if ($HOST eq $NAME) {
+ $found = 1;
+
+ $BASE = $ALLPLATTERS{$HOST};
+
+ print "Trawling ".$NAME."'s server @ http://$BASE\n";
+ print INVENTORY "http://$BASE\n";
+ my $TIME = time;
+ @RESULT = parse_page( 'http://'.$BASE.'/', $NAME);
+
+ my $INVENTORY = shift (@RESULT);
+ if ( length $INVENTORY > 0 ) {
+ print INVENTORY $INVENTORY;
+ my $count = shift @RESULT;
+
+ # remove duplicate artists
+ @RESULT = sort @RESULT;
+ my $i=0; my $last;
+ while ($i<=$#RESULT) {
+ if ($last eq $RESULT[$i]) {
+ splice @RESULT, $i, 1;
+ }
+ else {
+ $last = $RESULT[$i];
+ $i++;
+ }
+ }
+
+ print ARTISTS join("\n", @RESULT)."\n";
+ print "<p id=\"$NAME\">Indexed $count tracks in ".(time-$TIME)." seconds.<script>document.getElementById(\"$NAME\").scrollIntoView(false);</script>";
+
+ }
+ }
+ }
+ close INVENTORY;
+ close ARTISTS;
+ unless ($found) {
+ print "<br>Host $NAME is not registered platter host.";
+ }
+ }
+
+# Re-write the abcs file
+
+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;
+
+print "<h4 id=\"end\">All done</h4><script>document.getElementById(\"end\").scrollIntoView(false);</script></body></html>";
+unlink "../inventory/trawl.lock";
+}
+else
+{
+ # Generate form
+ #
+ print q{ <form name="twatsource">
+ <table border=0 cellpadding=1 cellspacing=0>
+ <tr>
+ <td>&nbsp;</td>
+ <td><b>User</b></td>
+ <td><b>Last Trawled</b></td>
+ </tr>
+ <tr><td colspan=3><hr size=1 color=white></td></tr>
+ };
+
+ my %TIMES;
+
+ foreach $HOST (keys %ALLPLATTERS)
+ {
+ my $HOSTFILE = '../inventory/'.$HOST.".inv";
+ my $thistime = 0;
+
+ if (-e $HOSTFILE)
+ {
+ my @stats = stat(_);
+ $thistime = $stats[9];
+ }
+
+ $TIMES{ $thistime.";".$HOST } .= $ALLPLATTERS{$HOST}."<br>";
+ }
+
+ my $TIME;
+ my $LASTMOD;
+
+ foreach $TIME (sort {$b <=> $a} keys %TIMES)
+ {
+ my ($THISTIME, $HOST) = split (/;/, $TIME);
+ my $URL = $TIMES{$TIME};
+ my $TRAWLABLE = 1;
+
+ if ($TIME > 0)
+ {
+ $LASTMOD = localtime($TIME)." CET";
+ if (time - $TIME < (60*$MINTRAWL))
+ {
+ $TRAWLABLE = 0;
+ }
+ }
+ else
+ {
+ $LASTMOD = "Not trawled yet";
+ }
+
+ print "<tr><td>";
+
+ if ($TRAWLABLE)
+ {
+ print "<input type=\"checkbox\" name=\"".$HOST."\">";
+ }
+ else
+ {
+ print "&nbsp;";
+ }
+ print "</td>";
+ print "<td nowrap valign=bottom><b>".$HOST."</b></td>";
+ print "<td nowrap valign=bottom>&nbsp;<small>".$LASTMOD."</small></td></tr>\n";
+
+}
+
+print qq{ </tr>
+ <tr><td colspan=3><hr size=1 color=white></td></tr></table>
+ </form>
+ <form><input type="button" onClick="twat()" value="Trawl"></form>
+ </body>
+ </html>
+ };
+
+}
+exit 0;
+
+
+
+# sub to recursively trawl http directories for A tags
+# should store all the recognised files it can find.
+#
+# should be called with 1 parameter
+# - path
+#
+sub parse_page
+{
+ my($URL, $NAME) = @_;
+ my $INVENTORY = "";
+ my @ARTISTS = ();
+ my $localcount = 0;
+ $RECURSE++;
+
+ if ($RECURSE < 3) {
+ my $FOLDER;
+ if ($RECURSE == 1) {
+ $FOLDER = $NAME."'s platter";
+ }
+ else {
+ $URL =~ /.*\/([^\/]+)\/*$/;
+ $FOLDER = makeNice($1);
+ }
+ print "<br><span id=\"line".$LINECOUNT."\">Indexing <b>".$FOLDER.":</b></span><script>document.getElementById(\"line".$LINECOUNT++."\").scrollIntoView(false);</script>\n";
+ }
+
+
+ #request page
+ my $REQUEST = HTTP::Request->new('GET', $URL , $HEADER);
+ my $RESPONSE = $USERAGENT->request($REQUEST);
+ #if response is successful
+ if ($RESPONSE->is_success)
+ {
+ #parse page that is returned
+ require HTML::Parse;
+ my $HTML = HTML::Parse::parse_html($RESPONSE->content);
+ my $base = $RESPONSE->base;
+ for ( @{ $HTML->extract_links } )
+ {
+ my($LINK, $elem) = @$_;
+ my $TAG = $elem->tag;
+
+ my $LINK = URI->new($LINK)->abs($base)->as_string;
+ #$LINK = makeUnNice($LINK);
+ $LINK =~ s/%25/%/g;
+ my $OUTPUT = $LINK;
+ $OUTPUT =~ s/(.*?)$BASE//;
+ my $EXT;
+ if ($OUTPUT =~ /\.(\w*)$/) { $EXT = $1;}
+
+ if ($TAG =~ /[Aa]/ && $URL !~ /\Q$LINK\E\/?.*/ && $LINK !~ /\?.*/)
+ {
+ if ($debug) { print "<br>$LINK\n" }
+ if (
+ $QUICKEXT =~ /$delim$EXT$delim/i
+ ||
+ $OUTPUT =~ /(artist|cover)[^\/]*\.(jpg|gif|png)$/i
+ ||
+ $OUTPUT =~ /.+\/info\.txt$/i
+ )
+ {
+ #if the file is recognised then
+
+ #add link to inventory
+ my @entry = makeInvLine($OUTPUT);
+
+ $INVENTORY .= join($delim, @entry)."$delim$OUTPUT\n";
+ push (@ARTISTS, $entry[0]) if $entry[0];
+ push (@ARTISTS, $entry[1]) if $entry[1];
+
+ if ($QUICKEXT =~ /$delim$EXT$delim/i) {$localcount++; }
+ }
+ elsif ($OUTPUT =~ /.abc$/i)
+ {
+ if ($OUTPUT =~ /([^\/]+)\/([^\/]+\.abc)$/)
+ {
+ my $PATH = makeNice($1); my $ARTIST = makeNice($2);
+ $ABCS{$PATH} = $ARTIST;
+ }
+ }
+ elsif ($OUTPUT =~ /^\/info\.txt$/i)
+ { # news page
+ my $NEWSREQUEST = HTTP::Request->new('GET', $LINK, $HEADER);
+ my $NEWSRESPONSE = $USERAGENT->request($NEWSREQUEST);
+ if ($NEWSRESPONSE->is_success)
+ {
+ my $lastmod = $NEWSRESPONSE->headers()->last_modified;
+ open(NEWS, ">../inventory/$NAME.news");
+ print NEWS $lastmod."\n";
+ print NEWS $NEWSRESPONSE->content;
+ close(NEWS);
+ print "<br>Fetched news page from $NAME";
+ }
+ else
+ {
+ print '<br><b style="color: red">Code '.$RESPONSE->code()." error fetching news page from $NAME: ".$RESPONSE->message().'</b>';
+ }
+ }
+ else
+ {
+ #print "<br>$LINK\n";
+ if ($LINK =~ /\Q$URL\E/i # previous link is a substring of the new one
+ && !($LINK=~ /\.\w{3}$/)) # do not retrieve anything with a dot and three chars at the end
+ {
+ if ($RECURSE < 5) # limit navigation to 5 folders deep - and that's taking the piss
+ {
+ my @CHILD = parse_page($LINK);
+ $INVENTORY.= shift(@CHILD);
+ $localcount += shift(@CHILD);
+ push(@ARTISTS, @CHILD);
+ }
+ else
+ {
+ print "<h3>Recursion limit hit, will not trawl child folders.<br>".
+ "Please check the format of your platter and contact Platter Support</h3>";
+ }
+
+ }
+ }
+ }
+ }
+ }
+ else {
+ print '<br><b style="color: red">Code '.$RESPONSE->code().' error indexing '.makeNice($URL).': '.$RESPONSE->message().'</b>'; }
+
+ if ($RECURSE == 2) {
+ print " $localcount tracks found.";
+ }
+ $RECURSE--;
+ return ($INVENTORY, $localcount, @ARTISTS);
+}
+
+sub makeInvLine( @_ ) {
+ my @items = split('/', $_[0]);
+ shift @items; # remove leading slash
+
+ # get artist folder
+ my $folder;
+ if ($#items > 0) {
+ $folder = shift @items;
+ $folder =~ s/^(The%20|)(.*?)(,%20The|)$/$2/i;
+ }
+
+ # get track
+
+ my $track = pop(@items);
+
+ # square brackets weren't seen for 6 years, but when they arrived they broke it
+ $track =~ s/\[/%5B/g;
+ $track =~ s/\]/%5D/g;
+
+
+ # get track artist
+ my $trackartist;
+ if ($track =~ /^(\d{2}%20-%20|)(The%20|)([^\/]*?)(,%20The|)%20-%20/i
+ && !($3 =~ /^\d{2}$/)
+ && length $3 > 0) {
+ $trackartist = $3;
+ $track =~ s/(The%20|)$trackartist(,%20The|)%20\-%20(.*?)/$3/;
+ }
+
+
+ # get album
+ my $album; my $year;
+ if ($#items > -1) {
+ $album = join('/', @items);
+
+ # get year
+ if ($album =~ /%20(\(|%28)(\d{4})(\)|%29)(\/|$)/) {
+ $year = $2;
+ }
+ }
+
+ return (
+ makeNice($folder),
+ makeNice($trackartist),
+ makeNice($album),
+ $year,
+ makeNice($track));
+
+}
generated by cgit v1.2.3 (git 2.39.1) at 2026-02-15 01:23:37 +0000