#!/usr/local/bin/perl # Count circs by call number use CGI; use CGI qw(:cgi-lib); use CGI qw(:standard); use CGI qw(:html3); my $spacing = ' ...'; $sourcedir = './sourcedata'; ReadParse(); $sourcefile= $sourcedir."/".$in{srcfile}; $threshold = $in{mincirc}; if ($in{display} eq call) {&CallCloud;} elsif ($in{display} eq subject) {&SubCloud;} elsif ($in{display} eq calllist) {&CallList;} elsif ($in{display} eq sublist) {&SubList;} else {&Menu;} sub Menu { opendir SDIR, $sourcedir; @sourcelist = grep !/^\./, readdir SDIR; @sortedsources = sort @sourcelist; &HTMLHead("Circ Clouds"); print qq(

Circ Clouds

); print qq(

); print qq(Select Source file to use:
); print qq(); print qq(

); print qq( Call Number Cloud
); print qq( Subject Cloud

); print qq(Enter minimum number of circulated items to display (enter 0 to see all)); print qq( ); print qq(
); print qq(); print qq (); } sub CallCloud { ############################################### # Loads the css info from the config.txt file ############################################### open( IN, "config.txt" ) || die "unable to open config.txt"; my $range = 0 ; while( ) { s/\t/ /g; s/ */ /g; s/[\r\n]//g; my( $count, $size, $colour ) = split( / / ); $range++; $size[$range] = $size; $check[$range] = $count; $colour[$range] = $colour; } close( IN ); ################################ # Read call numbers # Split out the class from the rest of the call number # Count number of titles for each class # Sort call numbers into proper order ################################# open (SOURCE, "$sourcefile") || die "unable to open $sourcefile"; %callcount=(); while ($callsubject=) { $callsubject =~ s/\"//g; ($call, $subject,$title,$bib)= split(/\|/,$callsubject); ($class = $call) =~ s/^(\w*)(\W|\.).*/$1/; $callcount{$class} += 1; if ($callcount{$class} <= 1) { push (@classlist, $call); } } @sortclass= sort sortcall @classlist; close (SOURCE); ########################################## # Output the result file ########################################## print "Content-type: text/html\n\n"; print qq(Foster Circulation by Call Number\n); foreach $classcount (@sortclass) { ($sclass = $classcount) =~ s/(\w*)(\W|\.).*/$1/; $sclass =~ s/\ //g; if ($sclass =~ /^CALL/) {next;} if ($callcount{$sclass} >= $threshold) { my $css = 1; foreach my $l ( 1 .. $range ) { if( $callcount{$sclass} > $check[$l] ) { $css = $l } } $css = 's'.$css; print qq( $sclass$spacing\n); } } print qq(\n); } sub SubCloud { ############################################## # Loads the css info from the config.txt file ############################################### open( IN, "config.txt" ) || die "unable to open config.txt"; my $range = 0 ; while( ) { s/\t/ /g; s/ */ /g; s/[\r\n]//g; my( $count, $size, $colour ) = split( / / ); $range++; $size[$range] = $size; $check[$range] = $count; $colour[$range] = $colour; } close( IN ); print "Content-type: text/html\n\n"; print qq(Circ Clouds\n); my $sublevel=1; my $subbase = $in{basesub}; if ($in{sublevel}) { $sublevel = $in{sublevel}; } $sublevel -= 1; open (SOURCE, "$sourcefile") || die "unable to open $sourcefile"; %subcount=(); while ($callsubject=) { @subcomp = (); $subview = ""; $callsubject =~ s/\"//g; ($call, $subject,$title,$bib)= split(/\|/,$callsubject); @multisub = split (/;/, $subject); PSUB: foreach $singlesub (@multisub) { @subparts = split (/ -- /, $singlesub); $sc = @subparts; $sc -= 1; foreach $sp (0 .. $sublevel) { if ($sp == 0) { $subview=$subparts[$sp]; } elsif ($sp >= 1) { if ($subparts[$sp]) { $subview = $subview." -- ".$subparts[$sp]; } } } foreach $scompare (@subcomp) { next PSUB if $scompare eq $subview; } push (@subcomp, $subview); $subcount{$subview} += 1; if ($subcount{$subview} <= 1) { if ($sublevel >=1) { next PSUB if $subview !~ /^$subbase(( --)|$)/; } push (@subsort, $subview); } } } @sortedsub = sort @subsort; print qq(

Subject Cloud

); if ($sublevel >=1) { print qq(

Second level cloud for subject heading: $subbase

); } foreach $subdisp (@sortedsub) { if ($subdisp =~ /^SUBJECT/) {next;} if ($subcount{$subdisp} >= $threshold) { my $css = 1; foreach my $l ( 1 .. $range ) { if( $subcount{$subdisp} > $check[$l] ) { $css = $l } } $css = 's'.$css; if ($subcount{$subdisp} >= 50) { $newlevel=$sublevel+2; print qq( $subdisp$spacing\n); } else { print qq( $subdisp$spacing\n); } # print qq($subcount{$subdisp} / $subdisp
); } } print qq(); } sub CallList { my %sourcecall = (); $qcall=$in{callno}; &HTMLHead("List of titles for $qcall"); print qq(

Titles checked out in $qcall

); print qq(); open (SOURCE, "$sourcefile"); while ($calltitle=) { $calltitle =~ s/\"//g; ($call, $subject,$title,$bib)= split(/\|/,$calltitle); if ($call =~ /^$qcall/) { $sourcecall{$call}=$calltitle; push (@rawcalls, $call); } } @sortedcalls= sort sortcall @rawcalls; $callcount=@sortedcalls; print qq(

$callcount Titles

); print qq(); foreach $outcalls (@sortedcalls) { ($call, $subject, $title, $bib) = split (/\|/, $sourcecall{$outcalls}); $bib =~ s/(\w*)\W/$1/g; chop ($bib); print qq(); print qq(); print qq(); print qq(); } print qq(

$call

$title

); print qq(); } sub SubList { my %sourcesub = (); $qsub=$in{basesub}; $qsub =~ s/(\W)/\\$1/g; # $qsub = $qsub." "; &HTMLHead("List of titles for $in{basesub}"); print qq(

Titles checked out in $in{basesub}

); print qq(); open (SOURCE, "$sourcefile"); while ($subtitle=) { $disp=0; $subtitle =~ s/\"//g; ($call, $subject,$title,$bib)= split(/\|/,$subtitle); my @multisub = split (/;/, $subject); foreach $sdisp (@multisub) { if (!$disp) { if ($sdisp =~ /^$qsub(( --)|$)/) { $sourcesub{$subject.$bib}=$subtitle; push (@rawsubs, $subject.$bib); $disp=1; } } } } my @sortedsubs = sort @rawsubs; my $subcount=@sortedsubs; print qq(

$subcount Titles

); print qq(); foreach $outsubs (@sortedsubs) { ($call, $subject, $title, $bib) = split (/\|/, $sourcesub{$outsubs}); $bib =~ s/(\w*)\W/$1/g; chop ($bib); print qq(); print qq(); print qq(); } print qq(

$title); $subject =~ s/;//g; print qq(

$subject

); print qq(); } sub sortcall { ($ap1, $ap2, $ap3, $ap4, $ap5) = ($a =~/\s*([a-zA-Z]+)\s*(\d+\.*\d*)\s*\.*([A-Z]+)\s*([0-9]+)\s*(.*)/i); ($bp1, $bp2, $bp3, $bp4, $bp5) = ($b =~ /\s*([a-zA-Z]+)\s*(\d+\.*\d*)\s*\.*([A-Z]+)\s*([0-9]+)\s*(.*)/i); if ($ap1 ne $bp1) # The class letters { return ($ap1 cmp $bp1); } elsif ($ap2 != $bp2) # The classnumbers { return ($ap2 <=> $bp2); } elsif ($ap3 ne $bp3) # The cutter letters { return ($ap3 cmp $bp3); } elsif ($ap4 != $bp4) # The cutter numbers { return ($ap4 <=> $bp4); } elsif ($ap5 ne $bp5) # The leftovers { return ($ap5 cmp $bp5); } else { return 0; } } sub HTMLHead { print "Content-Type: text/html\n\n"; print qq($_[0]); print qq (); print qq(); }