[Koha-cvs] koha cards/createcards.pl cards/select.pl koha-... [dev_week]

[Kyle Hall]

CVSROOT:        /sources/koha
Module name:    koha
Branch:         dev_week
Changes by:     Kyle Hall <kylemhall>   08/04/11 13:15:12

Added files:
        cards          : createcards.pl select.pl 
        koha-tmpl/intranet-tmpl/ccfls/en/cards: select.tmpl 

Log message:
        Added a Catalog Card printer.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/cards/createcards.pl?cvsroot=koha&only_with_tag=dev_week&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/cards/select.pl?cvsroot=koha&only_with_tag=dev_week&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/koha-tmpl/intranet-tmpl/ccfls/en/cards/select.tmpl?cvsroot=koha&only_with_tag=dev_week&rev=1.1.2.1

Patches:
Index: cards/createcards.pl
===================================================================
RCS file: cards/createcards.pl
diff -N cards/createcards.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ cards/createcards.pl        11 Apr 2008 13:15:11 -0000      1.1.2.1
@@ -0,0 +1,282 @@
+#!/usr/bin/perl
+
+use strict;
+
+use C4::Koha;
+use C4::Context;
+
+use PDF::Reuse;
+use MARC::Record;
+use CGI;
+
+use constant Y_TOP => 765;
+use constant Y_OFFSET => 210;
+
+use constant X_LEFT => 130;
+use constant X_INDENTED => X_LEFT + 50;
+use constant X_CENTER => 325;
+use constant X_RIGHT => 455;
+
+use constant INDENT => 5;
+
+use constant FH => 12; ## Font Height
+
+use constant MAX_STRING_WIDTH => 60;
+use constant MAX_CALLNUMBER_WIDTH => 5;
+
+my $dbh = C4::Context->dbh;
+
+
+my $input = new CGI;
+my $barcodeStart = $input->param('barcodeStart');
+my $barcodeEnd = $input->param('barcodeEnd');
+
+
+prInitVars();
+$| = 1;
+print STDOUT "Content-Disposition: attachment;filename=\"cards.pdf\"\n";
+print STDOUT "Content-Type: application/pdf \r\n\r\n";
+prFile();
+
+my $currentCard = 0;
+for ( my $barcode = $barcodeStart; $barcode <= $barcodeEnd; $barcode++ ) {
+  my $sth = $dbh->prepare("SELECT * FROM items, biblio, biblioitems
+                          WHERE items.biblionumber = biblio.biblionumber
+                          AND items.biblionumber = biblioitems.biblionumber
+                          AND items.barcode = ?");
+  $sth->execute( $barcode );
+  my $item = $sth->fetchrow_hashref;
+
+  createMainEntryCard( $item, $currentCard = getNextCardNum( $currentCard ) );
+  createTitleCard( $item, $currentCard = getNextCardNum( $currentCard ) );
+  
+  my @subjects = getSubjects( $item );
+  foreach my $subject ( @subjects ) {
+    createSubjectCard( $item, $currentCard = getNextCardNum( $currentCard ), 
$subject );
+  }
+  
+}
+
+prEnd();
+
+sub createTitleCard {
+  my ( $item, $cardNumber ) = @_;
+  
+  createMainEntryCard( $item, $cardNumber );
+  
+  printCardHeaderLine( $item, $cardNumber, $item->{'title'} );
+}
+
+sub createSubjectCard {
+  my ( $item, $cardNumber, $subject ) = @_;
+ 
+  createMainEntryCard( $item, $cardNumber );
+  
+  printCardHeaderLine( $item, $cardNumber, $subject );  
+}
+
+sub createMainEntryCard {
+  my ( $item, $cardNumber ) = @_;
+  
+  my $yo = Y_OFFSET * ( $cardNumber - 1 );
+  
+  my $line = 2;
+
+  printCallnumber( $item, $cardNumber );
+#  prText( X_LEFT, Y_TOP - Y_OFFSET * ( $cardNumber - 1 ) - FH * $line++, 
$item->{'itemcallnumber'} );
+
+  $line += printAuthorLine( $item, $cardNumber, $line );
+  $line += printTitleLine( $item, $cardNumber, $line );
+  $line += printPublisherLine( $item, $cardNumber, $line );
+  $line += printCopyrightLine( $item, $cardNumber, $line );
+  $line += printSeriesTitleLine( $item, $cardNumber, $line );
+  $line++;
+  $line += printAbstractLine( $item, $cardNumber, $line );
+  $line += printIsbnLine( $item, $cardNumber, $line );
+  $line++;
+  $line += printSubjectsLine( $item, $cardNumber, $line );
+}
+
+sub printCardHeaderLine {
+  my ( $item, $cardNumber, $header ) = @_;
+
+  prText( X_INDENTED + ( INDENT * 2 ), Y_TOP - Y_OFFSET * ( $cardNumber - 1 ) 
- ( FH / 2 ), $header );
+}
+
+sub printCallnumber {
+  my ( $item, $cardNumber ) = @_;
+  my @lines = split( / /, $item->{'itemcallnumber'} );
+  
+  my $l = 0;
+  foreach my $line ( @lines ) {
+    my @lines;
+    while ( length( $line ) > 0 ) {
+      push( @lines, substr( $line, 0, MAX_CALLNUMBER_WIDTH, '' ) );
+    }
+
+    foreach my $line ( @lines ) {
+      prText( X_LEFT, Y_TOP - Y_OFFSET * ( $cardNumber - 1 ) - FH * $l++, 
$line );
+    }
+  }
+}
+
+sub printAuthorLine {
+  my ( $item, $cardNumber, $line ) = @_;
+  return printLine( $item->{'author'}, $cardNumber, $line, 0 );
+}
+
+sub printTitleLine {
+  my ( $item, $cardNumber, $line ) = @_;
+  my $marc = MARC::Record->new_from_usmarc( $item->{'marc'} );
+  
+  my $text = $item->{'title'} . " / " . $marc->field('245')->subfield("c");
+  return printLine( $text, $cardNumber, $line, my $indent = 1 );
+}
+
+sub printPublisherLine {
+  my ( $item, $cardNumber, $line ) = @_;
+  my $text = $item->{'place'} . " : " . $item->{'publishercode'};
+  return printLine( $text, $cardNumber, $line );
+}
+
+sub printCopyrightLine {
+  my ( $item, $cardNumber, $line ) = @_;
+  my $marc = MARC::Record->new_from_usmarc( $item->{'marc'} );
+  
+  if ( $marc->field('260') && $marc->field('260')->subfield("c") ) { 
+    my $text = "c" . $marc->field('260')->subfield("c") . ".";
+    return printLine( $text, $cardNumber, $line );
+  } else {
+    return 0;
+  }
+}
+
+sub printSeriesTitleLine {
+  my ( $item, $cardNumber, $line ) = @_;
+  if ( $item->{'seriestitle'} ) {
+    my $text = "( " . $item->{'seriestitle'} . " ) ";
+    return printLine( $text, $cardNumber, $line, my $indent = 2 );
+  } else {
+    return 0;
+  }
+}
+
+sub printAbstractLine {
+  my ( $item, $cardNumber, $line ) = @_;
+  my $abstract = $item->{'abstract'};
+  
+  my @lines;
+  while ( length( $abstract ) > 0 ) {
+    push( @lines, substr( $abstract, 0, MAX_STRING_WIDTH, '' ) );
+  }
+
+  my $fh = FH - ( FH / 4 );
+  prFontSize( $fh );
+  
+  my $l = $line;
+  foreach my $line ( @lines ) {
+    $l += printLine( $line, $cardNumber, $l );
+  }
+  
+  prFontSize( FH );
+  
+  return $l - $line;
+}
+
+sub printIsbnLine {
+  my ( $item, $cardNumber, $line ) = @_;
+  my $text = "ISBN " . $item->{'isbn'};
+  return printLine( $text, $cardNumber, $line, my $indent = 2 );
+}
+
+sub printSubjectsLine {
+  my ( $item, $cardNumber, $line ) = @_;
+
+  my @subjects = getSubjects( $item );
+
+  my $l = $line;
+  foreach my $subject ( @subjects ) {
+    $l += printLine( $subject, $cardNumber, $l, my $indent = 2 );
+  }
+  
+  return $l - $line;
+}
+
+sub printLine {
+  my ( $text, $cardNumber, $line, $x_indents ) = @_;
+  prText( X_INDENTED + ( INDENT * $x_indents ), Y_TOP - Y_OFFSET * ( 
$cardNumber - 1 ) - FH * $line, $text );
+  return 1;
+}
+
+sub getNextCardNum {
+  my ( $currentCard ) = @_;
+  
+  $currentCard++;
+  
+  if ( $currentCard > 3 ) {
+    $currentCard = 1;
+    prPage();
+  }
+  
+  return $currentCard
+}
+
+sub getSubjects {
+  my ( $item ) = @_;
+  
+  my $dbh = C4::Context->dbh;
+  my $sth = $dbh->prepare("SELECT subject FROM bibliosubject WHERE 
biblionumber = ? ORDER BY subject");
+  $sth->execute( $item->{'biblionumber'} );
+  my @subjects;
+  while ( my $subject = $sth->fetchrow_hashref ) {
+    push( @subjects, $subject->{'subject'} );
+  }
+
+  return @subjects;
+}
+=pod
+print "<h1>Shelf</h1>";
+print "<p>Callnumber: " . $item->{'itemcallnumber'};
+print "<p>Author: " . $item->{'author'};
+print "<p>Title: " . $item->{'title'};
+print "<p>Statement of responsibility, etc: " . 
$marc->field('245')->subfield("c");
+print "<p>Place: " . $item->{'place'};
+print "<p>Publisher Code: " . $item->{'publishercode'};
+print "<p>Price: " . $item->{'price'};
+print "<p>Barcode: " . $item->{'barcode'};
+print "<p>Series Title: " . $item->{'seriestitle'};
+print "<p>ISBN: " . $item->{'isbn'};
+print "<p>Date Accessioned: " . $item->{'dateaccessioned'};
+foreach my $subject ( @subjects ) {
+  print "<p>Subject: $subject";
+}
+
+foreach my $subject ( @subjects ) {
+  print "<h1>Subject: $subject</h1>";
+  print "<p>Subject: $subject";
+  print "<p>Callnumber: " . $item->{'itemcallnumber'};
+  print "<p>Author: " . $item->{'author'};
+  print "<p>Title: " . $item->{'title'};
+  print "<p>Statement of responsibility, etc: " . 
$marc->field('245')->subfield("c");
+  print "<p>Place: " . $item->{'place'};
+  print "<p>Publisher Code: " . $item->{'publishercode'};
+  print "<p>Price: " . $item->{'price'};
+  print "<p>Barcode: " . $item->{'barcode'};
+  print "<p>Series Title: " . $item->{'seriestitle'};
+  print "<p>Abstract: " . $item->{'abstract'};
+  print "<p>ISBN: " . $item->{'isbn'};
+  foreach my $subject ( @subjects ) {
+    print "<p>Subject: $subject";
+  }
+
+}
+=cut
+
+
+# Perl trim function to remove whitespace from the start and end of the string
+sub trim($) {
+  my $string = shift;
+  $string =~ s/^\s+//;
+  $string =~ s/\s+$//;
+  return $string;
+}
\ No newline at end of file

Index: cards/select.pl
===================================================================
RCS file: cards/select.pl
diff -N cards/select.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ cards/select.pl     11 Apr 2008 13:15:11 -0000      1.1.2.1
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use C4::Auth;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use CGI;
+use HTML::Template;
+
+my $input=new CGI;
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+    {
+        template_name   => "cards/select.tmpl",
+        query           => $input,
+        type            => "intranet",
+        authnotrequired => 1,
+        debug           => 1,
+    }
+);
+$template->param(
+    intranetcolorstylesheet =>
+      C4::Context->preference("intranetcolorstylesheet"),
+    intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+    IntranetNav        => C4::Context->preference("IntranetNav"),
+);
+print $input->header(
+    -type   => guesstype( $template->output ),
+    -cookie => $cookie
+  ),
+  $template->output;
+

Index: koha-tmpl/intranet-tmpl/ccfls/en/cards/select.tmpl
===================================================================
RCS file: koha-tmpl/intranet-tmpl/ccfls/en/cards/select.tmpl
diff -N koha-tmpl/intranet-tmpl/ccfls/en/cards/select.tmpl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ koha-tmpl/intranet-tmpl/ccfls/en/cards/select.tmpl  11 Apr 2008 13:15:12 
-0000      1.1.2.1
@@ -0,0 +1,22 @@
+<!-- TMPL_INCLUDE NAME="head.inc" -->
+<!-- TMPL_INCLUDE NAME="body-top.inc" -->
+<!-- TMPL_INCLUDE NAME="body-top-noneSelected.inc" -->
+  <dl class="bodyPane">
+    <dt class="bodyPane">Print Catalog Cards</dt>
+
+    <dd class="bodyPane">
+       &nbsp;
+       <h1>Barcode Range</h1>
+       <form method="post" action="createcards.pl" name="mainform" 
id="mainform">
+               <label for="barcodeStart">Starting Barcode</label>
+               <input type="text" name="barcodeStart" />
+                       
+               <label for="barcodeEnd">Ending Barcode</label>
+               <input type="text" name="barcodeEnd" />
+
+                <input type="submit" value="Create Cards" class="submit" />
+       </form>
+    </dd>
+  </dl>
+</body>
+</html>