From: Michael Tremer Date: Fri, 23 Dec 2011 13:21:57 +0000 (+0100) Subject: perl-Tk: New package. X-Git-Url: http://git.ipfire.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Fperl-Tk;p=people%2Fms%2Fipfire-3.x.git perl-Tk: New package. Required by perl itself. --- diff --git a/perl-Tk/patches/perl-Tk-debian.patch b/perl-Tk/patches/perl-Tk-debian.patch new file mode 100644 index 000000000..6b945b4b1 --- /dev/null +++ b/perl-Tk/patches/perl-Tk-debian.patch @@ -0,0 +1,71 @@ +--- perl-tk-804.027.orig/objGlue.c ++++ perl-tk-804.027/objGlue.c +@@ -529,6 +529,10 @@ + sv_utf8_upgrade(objPtr); + #endif + s = SvPV(objPtr, len); ++ if (!s) ++ { ++ return NULL; ++ } + #ifdef SvUTF8 + if (!is_utf8_string(s,len)) + { +@@ -555,6 +559,10 @@ + else + { + s = LangString(objPtr); ++ if (!s) ++ { ++ return NULL; ++ } + #ifdef SvUTF8 + if (!is_utf8_string(s,strlen(s))) + { +--- perl-tk-804.027.orig/pTk/mTk/generic/tkFont.c ++++ perl-tk-804.027/pTk/mTk/generic/tkFont.c +@@ -1044,6 +1044,7 @@ + TkFont *fontPtr, *firstFontPtr, *oldFontPtr; + int new, descent; + NamedFont *nfPtr; ++ char *fontString; + + fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; + if (objPtr->typePtr != &tkFontObjType) { +@@ -1077,8 +1078,12 @@ + cacheHashPtr = oldFontPtr->cacheHashPtr; + FreeFontObjProc(objPtr); + } else { ++ fontString = Tcl_GetString(objPtr); ++ if (fontString == NULL) { ++ fontString = ""; ++ } + cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache, +- Tcl_GetString(objPtr), &new); ++ fontString, &new); + } + firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr); + for (fontPtr = firstFontPtr; (fontPtr != NULL); +@@ -1095,8 +1100,12 @@ + * The desired font isn't in the table. Make a new one. + */ + ++ fontString = Tcl_GetString(objPtr); ++ if (fontString == NULL) { ++ fontString = ""; ++ } + namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, +- Tcl_GetString(objPtr)); ++ fontString); + if (namedHashPtr != NULL) { + /* + * Construct a font based on a named font. +@@ -1111,7 +1120,7 @@ + * Native font? + */ + +- fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr)); ++ fontPtr = TkpGetNativeFont(tkwin, fontString); + if (fontPtr == NULL) { + TkFontAttributes fa; + Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr); diff --git a/perl-Tk/patches/perl-Tk-seg.patch b/perl-Tk/patches/perl-Tk-seg.patch new file mode 100644 index 000000000..26201fa3a --- /dev/null +++ b/perl-Tk/patches/perl-Tk-seg.patch @@ -0,0 +1,33 @@ +diff -up Tk-804.028/pTk/mTk/generic/tkConfig.c.seg Tk-804.028/pTk/mTk/generic/tkConfig.c +--- Tk-804.028/pTk/mTk/generic/tkConfig.c.seg 2008-03-11 23:29:39.000000000 -0400 ++++ Tk-804.028/pTk/mTk/generic/tkConfig.c 2008-03-11 23:28:09.000000000 -0400 +@@ -1210,11 +1210,11 @@ GetOptionFromObj(interp, objPtr, tablePt + * First, check to see if the object already has the answer cached. + */ + +- if (objPtr->typePtr == &tkOptionObjType) { ++/* if (objPtr->typePtr == &tkOptionObjType) { + if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) { + return (Option *) objPtr->internalRep.twoPtrValue.ptr2; + } +- } ++ }*/ + + /* + * The answer isn't cached. +@@ -2277,9 +2277,15 @@ Tk_GetOptionValue(interp, recordPtr, opt + if (optionPtr == NULL) { + return NULL; + } ++ ++ if (optionPtr->specPtr == NULL) { ++ return NULL; ++ } ++ + if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) { + optionPtr = optionPtr->extra.synonymPtr; + } ++ + if (optionPtr->specPtr->objOffset >= 0) { + resultPtr = *((Tcl_Obj **) (recordPtr + optionPtr->specPtr->objOffset)); + if (resultPtr == NULL) { diff --git a/perl-Tk/patches/perl-Tk-widget.patch0 b/perl-Tk/patches/perl-Tk-widget.patch0 new file mode 100644 index 000000000..ec446586d --- /dev/null +++ b/perl-Tk/patches/perl-Tk-widget.patch0 @@ -0,0 +1,26 @@ +--- demos/widget.orig 2008-01-02 13:24:14.000000000 +0100 ++++ demos/widget 2008-01-02 13:27:10.000000000 +0100 +@@ -3,7 +3,8 @@ + use 5.008; + use Config; + use Tk 804.000; +-use lib Tk->findINC( 'demos/widget_lib' ); ++#use lib Tk->findINC( 'demos/widget_lib' ); ++use lib "@demopath@/widget_lib"; + use Tk::widgets qw/ DialogBox ErrorDialog LabEntry ROText /; + use Tk::Config (); + use WidgetDemo; +@@ -62,9 +63,11 @@ + $l->destroy; + } + +-my $widget_lib = Tk->findINC('demos/widget_lib'); ++#my $widget_lib = Tk->findINC('demos/widget_lib'); ++my $widget_lib = "@demopath@/widget_lib"; + my $wd = "$widget_lib/WidgetDemo.pm"; +-$WIDTRIB = Tk->findINC('demos/widtrib'); ++#$WIDTRIB = Tk->findINC('demos/widtrib'); ++$WIDTRIB = "@demopath@/widtrib"; + unless (Tk::tainting) { + $WIDTRIB = $ENV{WIDTRIB} if defined $ENV{WIDTRIB}; + $WIDTRIB = $ARGV[0] if defined $ARGV[0]; diff --git a/perl-Tk/perl-Tk.nm b/perl-Tk/perl-Tk.nm new file mode 100644 index 000000000..f73502ed1 --- /dev/null +++ b/perl-Tk/perl-Tk.nm @@ -0,0 +1,65 @@ +############################################################################### +# IPFire.org - An Open Source Firewall Solution # +# Copyright (C) - IPFire Development Team # +############################################################################### + +name = perl-Tk +version = 804.029 +release = 1 +thisapp = Tk-%{version} + +groups = Development/Libraries +url = http://search.cpan.org/dist/Tk/ +license = GPL+ or Artistic +summary = Perl Graphical User Interface ToolKit. + +description + This a re-port of a perl interface to Tk8.4. + C code is derived from Tcl/Tk8.4.5. + It also includes all the C code parts of Tix8.1.4 from SourceForge. + The perl code corresponding to Tix's Tcl code is not fully implemented. + + Perl API is essentially the same as Tk800 series Tk800.025 but has not + been verified as compliant. There ARE differences see pod/804delta.pod. +end + +source_dl = http://cpan.org/modules/by-module/Tk/ + +build + requires + perl(ExtUtils::ParseXS) + perl(ExtUtils::MakeMaker) + perl-devel + libjpeg-devel + libpng-devel + libX11-devel + libXft-devel + end + + build + perl Makefile.PL INSTALLDIRS=vendor X11LIB=%{libdir} XFT=1 + make %{PARALLELISMFLAGS} + end + + install + make pure_install PERL_INSTALL_ROOT=%{BUILDROOT} + end +end + +packages + package %{name} + provides + perl(Tk::LabRadio) = 4.004 + perl(Tk::TextReindex) + perl(Tk) = %{version} + end + end + + package %{name}-devel + template DEVEL + end + + package %{name}-debuginfo + template DEBUGINFO + end +end