1 /*************************************************************************
2  *
3  * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
4  *
5  * Copyright 2000, 2010 Oracle and/or its affiliates.
6  *
7  * OpenOffice.org - a multi-platform office productivity suite
8  *
9  * This file is part of OpenOffice.org.
10  *
11  * OpenOffice.org is free software: you can redistribute it and/or modify
12  * it under the terms of the GNU Lesser General Public License version 3
13  * only, as published by the Free Software Foundation.
14  *
15  * OpenOffice.org is distributed in the hope that it will be useful,
16  * but WITHOUT ANY WARRANTY; without even the implied warranty of
17  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18  * GNU Lesser General Public License version 3 for more details
19  * (a copy is included in the LICENSE file that accompanied this code).
20  *
21  * You should have received a copy of the GNU Lesser General Public License
22  * version 3 along with OpenOffice.org.  If not, see
23  * <http://www.openoffice.org/license.html>
24  * for a copy of the LGPLv3 License.
25  *
26  ************************************************************************/
27 #include "vbadocumentproperties.hxx"
28 #include <cppuhelper/implbase1.hxx>
29 #include <cppuhelper/implbase3.hxx>
30 #include <com/sun/star/document/XDocumentInfoSupplier.hpp>
31 #include <com/sun/star/document/XDocumentPropertiesSupplier.hpp>
32 #include <com/sun/star/beans/NamedValue.hpp>
33 #include <com/sun/star/beans/XPropertyContainer.hpp>
34 #include <ooo/vba/word/WdBuiltInProperty.hpp>
35 #include <ooo/vba/office/MsoDocProperties.hpp>
36 #include <memory>
37 #include <boost/shared_ptr.hpp>
38 #include "wordvbahelper.hxx"
39 #include "fesh.hxx"
40 #include "docsh.hxx"
41 using namespace ::ooo::vba;
42 using namespace css;
43 
44 sal_Int8 lcl_toMSOPropType( const uno::Type& aType ) throw ( lang::IllegalArgumentException )
45 {
46     sal_Int16 msoType = office::MsoDocProperties::msoPropertyTypeString;
47 
48     switch ( aType.getTypeClass() )
49     {
50         case uno::TypeClass_BOOLEAN:
51             msoType =  office::MsoDocProperties::msoPropertyTypeBoolean;
52             break;
53         case uno::TypeClass_FLOAT:
54             msoType =  office::MsoDocProperties::msoPropertyTypeFloat;
55             break;
56         case uno::TypeClass_STRUCT: // Assume date
57             msoType =  office::MsoDocProperties::msoPropertyTypeDate;
58             break;
59         case  uno::TypeClass_BYTE:
60         case  uno::TypeClass_SHORT:
61         case  uno::TypeClass_LONG:
62         case  uno::TypeClass_HYPER:
63             msoType =  office::MsoDocProperties::msoPropertyTypeNumber;
64             break;
65         default:
66             throw lang::IllegalArgumentException();
67     }
68     return msoType;
69 }
70 
71 class PropertGetSetHelper
72 {
73 protected:
74     uno::Reference< frame::XModel > m_xModel;
75     uno::Reference< beans::XPropertySet > mxProps;
76 public:
77     PropertGetSetHelper( const uno::Reference< frame::XModel >& xModel ):m_xModel( xModel )
78     {
79         uno::Reference< document::XDocumentInfoSupplier > xDocInfoSupp( m_xModel, uno::UNO_QUERY_THROW );
80         mxProps.set( xDocInfoSupp->getDocumentInfo(), uno::UNO_QUERY_THROW );
81     }
82     virtual ~PropertGetSetHelper() {}
83     virtual uno::Any getPropertyValue( const rtl::OUString& rPropName ) = 0;
84     virtual void setPropertyValue( const rtl::OUString& rPropName, const uno::Any& aValue ) = 0;
85     virtual uno::Reference< beans::XPropertySet > getUnoProperties() { return mxProps; }
86 
87 };
88 
89 class BuiltinPropertyGetSetHelper : public PropertGetSetHelper
90 {
91 public:
92     BuiltinPropertyGetSetHelper( const uno::Reference< frame::XModel >& xModel ) :PropertGetSetHelper( xModel )
93     {
94     }
95     virtual uno::Any getPropertyValue( const rtl::OUString& rPropName )
96     {
97         if ( rPropName.equals( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("EditingDuration" ) ) ) )
98         {
99             sal_Int32 nSecs = 0;
100             mxProps->getPropertyValue( rPropName ) >>= nSecs;
101             return uno::makeAny( nSecs/60 ); // minutes
102         }
103         return mxProps->getPropertyValue( rPropName );
104     }
105     virtual void setPropertyValue( const rtl::OUString& rPropName, const uno::Any& aValue )
106     {
107         mxProps->setPropertyValue( rPropName, aValue );
108     }
109 };
110 
111 class CustomPropertyGetSetHelper : public BuiltinPropertyGetSetHelper
112 {
113 public:
114     CustomPropertyGetSetHelper( const uno::Reference< frame::XModel >& xModel ) :BuiltinPropertyGetSetHelper( xModel )
115     {
116         uno::Reference< document::XDocumentPropertiesSupplier > xDocPropSupp( mxProps, uno::UNO_QUERY_THROW );
117         uno::Reference< document::XDocumentProperties > xDocProp( xDocPropSupp->getDocumentProperties(), uno::UNO_QUERY_THROW );
118         mxProps.set( xDocProp->getUserDefinedProperties(), uno::UNO_QUERY_THROW );
119     }
120 };
121 class StatisticPropertyGetSetHelper : public PropertGetSetHelper
122 {
123     SwDocShell* mpDocShell;
124     uno::Reference< beans::XPropertySet > mxModelProps;
125 public:
126     StatisticPropertyGetSetHelper( const uno::Reference< frame::XModel >& xModel ) :PropertGetSetHelper( xModel ) , mpDocShell( NULL )
127     {
128             mxModelProps.set( m_xModel, uno::UNO_QUERY_THROW );
129             mpDocShell = word::getDocShell( xModel );
130     }
131     virtual uno::Any getPropertyValue( const rtl::OUString& rPropName )
132     {
133         uno::Sequence< beans::NamedValue > stats;
134         try
135         {
136             // Characters, ParagraphCount & WordCount are available from
137             // the model ( and addtionally these also update the statics object )
138             //return mxProps->getPropertyValue( rPropName );
139             return mxModelProps->getPropertyValue( rPropName );
140         }
141         catch( uno::Exception& )
142         {
143             OSL_TRACE("Got exception");
144         }
145         uno::Any aReturn;
146         if ( rPropName.equals( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("LineCount")) ) ) // special processing needed
147         {
148             if ( mpDocShell )
149             {
150                 SwFEShell* pFEShell = mpDocShell->GetFEShell();
151                 if(pFEShell)
152                 {
153                     aReturn <<= pFEShell->GetLineCount(sal_False);
154                 }
155             }
156         }
157         else
158         {
159             mxModelProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ParagraphCount") ) ) >>= stats;
160             mxProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("DocumentStatistic") ) ) >>= stats;
161 
162             sal_Int32 nLen = stats.getLength();
163             bool bFound = false;
164             for ( sal_Int32 index = 0; index < nLen && !bFound ; ++index )
165             {
166                 if ( rPropName.equals( stats[ index ].Name ) )
167                 {
168                     aReturn = stats[ index ].Value;
169                     bFound = true;
170                 }
171             }
172             if ( !bFound )
173                 throw uno::RuntimeException(); // bad Property
174         }
175         return aReturn;
176     }
177 
178     virtual void setPropertyValue( const rtl::OUString& rPropName, const uno::Any& aValue )
179     {
180 
181         uno::Sequence< beans::NamedValue > stats;
182         mxProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("DocumentStatistic") ) ) >>= stats;
183 
184         sal_Int32 nLen = stats.getLength();
185         for ( sal_Int32 index = 0; index < nLen; ++index )
186         {
187             if ( rPropName.equals( stats[ index ].Name ) )
188             {
189                 stats[ index ].Value = aValue;
190                 mxProps->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("DocumentStatistic") ), uno::makeAny( stats ) );
191                 break;
192             }
193         }
194     }
195 };
196 
197 class DocPropInfo
198 {
199 public:
200     rtl::OUString msMSODesc;
201     rtl::OUString msOOOPropName;
202     boost::shared_ptr< PropertGetSetHelper > mpPropGetSetHelper;
203 
204     static DocPropInfo createDocPropInfo( const rtl::OUString& sDesc, const rtl::OUString& sPropName, boost::shared_ptr< PropertGetSetHelper >& rHelper )
205     {
206         return createDocPropInfo( rtl::OUStringToOString( sDesc, RTL_TEXTENCODING_UTF8 ).getStr(), rtl::OUStringToOString( sPropName, RTL_TEXTENCODING_UTF8 ).getStr(), rHelper );
207     }
208 
209     static DocPropInfo createDocPropInfo( const sal_Char* sDesc, const sal_Char* sPropName, boost::shared_ptr< PropertGetSetHelper >& rHelper )
210     {
211         DocPropInfo aItem;
212         aItem.msMSODesc = rtl::OUString::createFromAscii( sDesc );
213         aItem.msOOOPropName = rtl::OUString::createFromAscii( sPropName );
214         aItem.mpPropGetSetHelper = rHelper;
215         return aItem;
216     }
217     uno::Any getValue()
218     {
219         if ( mpPropGetSetHelper.get() )
220             return mpPropGetSetHelper->getPropertyValue( msOOOPropName );
221         return uno::Any();
222     }
223     void setValue( const uno::Any& rValue )
224     {
225         if ( mpPropGetSetHelper.get() )
226             mpPropGetSetHelper->setPropertyValue( msOOOPropName, rValue );
227     }
228     uno::Reference< beans::XPropertySet > getUnoProperties()
229     {
230 
231         uno::Reference< beans::XPropertySet > xProps;
232         if ( mpPropGetSetHelper.get() )
233             return mpPropGetSetHelper->getUnoProperties();
234         return xProps;
235     }
236 };
237 
238 
239 typedef std::hash_map< sal_Int32, DocPropInfo > MSOIndexToOODocPropInfo;
240 
241 class BuiltInIndexHelper
242 {
243     MSOIndexToOODocPropInfo m_docPropInfoMap;
244     BuiltInIndexHelper();
245 public:
246     BuiltInIndexHelper( const uno::Reference< frame::XModel >& xModel )
247     {
248         boost::shared_ptr< PropertGetSetHelper > aStandardHelper( new BuiltinPropertyGetSetHelper( xModel ) );
249         boost::shared_ptr< PropertGetSetHelper > aUsingStatsHelper( new StatisticPropertyGetSetHelper( xModel ) );
250 
251         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyTitle ] = DocPropInfo::createDocPropInfo( "Title", "Title", aStandardHelper );
252         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertySubject ] = DocPropInfo::createDocPropInfo( "Subject", "Subject", aStandardHelper );
253         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyAuthor ] = DocPropInfo::createDocPropInfo( "Author", "Author", aStandardHelper );
254         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyKeywords ] = DocPropInfo::createDocPropInfo( "Keywords", "Keywords", aStandardHelper );
255         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyComments ] = DocPropInfo::createDocPropInfo( "Comments", "Description", aStandardHelper );
256         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyTemplate ] = DocPropInfo::createDocPropInfo( "Template", "Template", aStandardHelper );
257         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyLastAuthor ] = DocPropInfo::createDocPropInfo( "Last author", "ModifiedBy", aStandardHelper ); // doesn't seem to exist - throw or return nothing ?
258         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyRevision ] = DocPropInfo::createDocPropInfo( "Revision number", "EditingCycles", aStandardHelper ); // doesn't seem to exist - throw or return nothing ?
259         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyAppName ] = DocPropInfo::createDocPropInfo( "Application name", "Generator", aStandardHelper ); // doesn't seem to exist - throw or return nothing ?
260         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyTimeLastPrinted ] = DocPropInfo::createDocPropInfo( "Last print date", "PrintDate", aStandardHelper ); // doesn't seem to exist - throw or return nothing ?
261         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyTimeCreated ] = DocPropInfo::createDocPropInfo( "Creation date", "CreationDate", aStandardHelper );
262         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyTimeLastSaved ] = DocPropInfo::createDocPropInfo( "Last save time", "ModifyDate", aStandardHelper );
263         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyVBATotalEdit ] = DocPropInfo::createDocPropInfo( "Total editing time", "EditingDuration", aStandardHelper ); // Not sure if this is correct
264         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyPages ] = DocPropInfo::createDocPropInfo( "Number of pages", "PageCount", aUsingStatsHelper ); // special handling required ?
265         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyWords ] = DocPropInfo::createDocPropInfo( "Number of words", "WordCount", aUsingStatsHelper ); // special handling require ?
266         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyCharacters ] = DocPropInfo::createDocPropInfo( "Number of characters", "CharacterCount", aUsingStatsHelper ); // special handling required ?
267         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertySecurity ] = DocPropInfo::createDocPropInfo( "Security", "", aStandardHelper ); // doesn't seem to exist
268         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyCategory ] = DocPropInfo::createDocPropInfo( "Category", "Category", aStandardHelper ); // hacked in
269         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyFormat ] = DocPropInfo::createDocPropInfo( "Format", "", aStandardHelper ); // doesn't seem to exist
270         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyManager ] = DocPropInfo::createDocPropInfo( "Manager", "Manager", aStandardHelper ); // hacked in
271         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyCompany ] = DocPropInfo::createDocPropInfo( "Company", "Company", aStandardHelper ); // hacked in
272         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyBytes ] = DocPropInfo::createDocPropInfo( "Number of bytes", "", aStandardHelper ); // doesn't seem to exist - size on disk exists ( for an already saved document ) perhaps it will do ( or we need something else )
273         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyLines ] = DocPropInfo::createDocPropInfo( "Number of lines", "LineCount", aUsingStatsHelper ); // special handling
274         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyParas ] = DocPropInfo::createDocPropInfo( "Number of paragraphs", "ParagraphCount", aUsingStatsHelper ); // special handling
275         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertySlides ] = DocPropInfo::createDocPropInfo( "Number of slides", "" , aStandardHelper ); // doesn't seem to exist
276         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyNotes ] = DocPropInfo::createDocPropInfo( "Number of notes", "", aStandardHelper ); // doesn't seem to exist
277         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyHiddenSlides ] = DocPropInfo::createDocPropInfo("Number of hidden Slides", "", aStandardHelper  ); // doesn't seem to exist
278         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyMMClips ] = DocPropInfo::createDocPropInfo( "Number of multimedia clips", "", aStandardHelper ); // doesn't seem to exist
279         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyHyperlinkBase ] = DocPropInfo::createDocPropInfo( "Hyperlink base", "AutoloadURL", aStandardHelper );
280         m_docPropInfoMap[ word::WdBuiltInProperty::wdPropertyCharsWSpaces ] = DocPropInfo::createDocPropInfo( "Number of characters (with spaces)", "", aStandardHelper ); // doesn't seem to be supported
281     }
282 
283     MSOIndexToOODocPropInfo& getDocPropInfoMap() { return m_docPropInfoMap; }
284 };
285 
286 
287 typedef InheritedHelperInterfaceImpl1< ooo::vba::XDocumentProperty > SwVbaDocumentProperty_BASE;
288 
289 class SwVbaBuiltInDocumentProperty : public SwVbaDocumentProperty_BASE
290 {
291 protected:
292     DocPropInfo mPropInfo;
293 public:
294     SwVbaBuiltInDocumentProperty(  const uno::Reference< ov::XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext >& xContext, const DocPropInfo& rInfo );
295     // XDocumentProperty
296     virtual void SAL_CALL Delete(  ) throw (script::BasicErrorException, uno::RuntimeException);
297     virtual ::rtl::OUString SAL_CALL getName(  ) throw (script::BasicErrorException, uno::RuntimeException);
298     virtual void SAL_CALL setName( const ::rtl::OUString& Name ) throw (script::BasicErrorException, uno::RuntimeException);
299     virtual ::sal_Int8 SAL_CALL getType(  ) throw (script::BasicErrorException, uno::RuntimeException);
300     virtual void SAL_CALL setType( ::sal_Int8 Type ) throw (script::BasicErrorException, uno::RuntimeException);
301     virtual ::sal_Bool SAL_CALL getLinkToContent(  ) throw (script::BasicErrorException, uno::RuntimeException);
302     virtual void SAL_CALL setLinkToContent( ::sal_Bool LinkToContent ) throw (script::BasicErrorException, uno::RuntimeException);
303     virtual uno::Any SAL_CALL getValue(  ) throw (script::BasicErrorException, uno::RuntimeException);
304     virtual void SAL_CALL setValue( const uno::Any& Value ) throw (script::BasicErrorException, uno::RuntimeException);
305     virtual rtl::OUString SAL_CALL getLinkSource(  ) throw (script::BasicErrorException, uno::RuntimeException);
306     virtual void SAL_CALL setLinkSource( const rtl::OUString& LinkSource ) throw (script::BasicErrorException, uno::RuntimeException);
307     //XDefaultProperty
308     virtual ::rtl::OUString SAL_CALL getDefaultPropertyName(  ) throw (uno::RuntimeException) { return rtl::OUString::createFromAscii("Value"); }
309     // XHelperInterface
310     virtual rtl::OUString& getServiceImplName();
311     virtual uno::Sequence<rtl::OUString> getServiceNames();
312 };
313 
314 class SwVbaCustomDocumentProperty : public SwVbaBuiltInDocumentProperty
315 {
316 public:
317 
318     SwVbaCustomDocumentProperty(  const uno::Reference< ov::XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext >& xContext, const DocPropInfo& rInfo );
319 
320     virtual ::sal_Bool SAL_CALL getLinkToContent(  ) throw (script::BasicErrorException, uno::RuntimeException);
321     virtual void SAL_CALL setLinkToContent( ::sal_Bool LinkToContent ) throw (script::BasicErrorException, uno::RuntimeException);
322 
323     virtual rtl::OUString SAL_CALL getLinkSource(  ) throw (script::BasicErrorException, uno::RuntimeException);
324     virtual void SAL_CALL setLinkSource( const rtl::OUString& LinkSource ) throw (script::BasicErrorException, uno::RuntimeException);
325     virtual void SAL_CALL Delete(  ) throw (script::BasicErrorException, uno::RuntimeException);
326     virtual void SAL_CALL setName( const ::rtl::OUString& Name ) throw (script::BasicErrorException, uno::RuntimeException);
327     virtual void SAL_CALL setType( ::sal_Int8 Type ) throw (script::BasicErrorException, uno::RuntimeException);
328 
329 };
330 
331 
332 SwVbaCustomDocumentProperty::SwVbaCustomDocumentProperty(  const uno::Reference< ov::XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext >& xContext, const DocPropInfo& rInfo ) : SwVbaBuiltInDocumentProperty( xParent, xContext, rInfo )
333 {
334 }
335 
336 sal_Bool
337 SwVbaCustomDocumentProperty::getLinkToContent(  ) throw (script::BasicErrorException, uno::RuntimeException)
338 {
339     // #FIXME we need to store the link content somewhere
340     return sal_False;
341 }
342 
343 void
344 SwVbaCustomDocumentProperty::setLinkToContent( sal_Bool /*bLinkContent*/ ) throw (script::BasicErrorException, uno::RuntimeException)
345 {
346 }
347 
348 rtl::OUString
349 SwVbaCustomDocumentProperty::getLinkSource(  ) throw (script::BasicErrorException, uno::RuntimeException)
350 {
351     // #FIXME we need to store the link content somewhere
352     return rtl::OUString();;
353 }
354 
355 void
356 SwVbaCustomDocumentProperty::setLinkSource( const rtl::OUString& /*rsLinkContent*/ ) throw (script::BasicErrorException, uno::RuntimeException)
357 {
358     // #FIXME we need to store the link source somewhere
359 }
360 
361 void SAL_CALL
362 SwVbaCustomDocumentProperty::setName( const ::rtl::OUString& /*Name*/ ) throw (script::BasicErrorException, uno::RuntimeException)
363 {
364     // setName on existing property ?
365     // #FIXME
366     // do we need to delete existing property and create a new one?
367 }
368 
369 void SAL_CALL
370 SwVbaCustomDocumentProperty::setType( ::sal_Int8 /*Type*/ ) throw (script::BasicErrorException, uno::RuntimeException)
371 {
372     // setType, do we need to do a conversion?
373     // #FIXME the underlying value needs to be changed to the new type
374 }
375 
376 void SAL_CALL
377 SwVbaCustomDocumentProperty::Delete(  ) throw (script::BasicErrorException, uno::RuntimeException)
378 {
379     uno::Reference< beans::XPropertyContainer > xContainer( mPropInfo.getUnoProperties(), uno::UNO_QUERY_THROW );
380     xContainer->removeProperty( getName() );
381 }
382 
383 SwVbaBuiltInDocumentProperty::SwVbaBuiltInDocumentProperty( const uno::Reference< ov::XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext >& xContext, const DocPropInfo& rInfo ) : SwVbaDocumentProperty_BASE( xParent, xContext ), mPropInfo( rInfo )
384 {
385 }
386 
387 void SAL_CALL
388 SwVbaBuiltInDocumentProperty::Delete(  ) throw (script::BasicErrorException, uno::RuntimeException)
389 {
390     // not valid for Builtin
391     throw uno::RuntimeException();
392 }
393 
394 ::rtl::OUString SAL_CALL
395 SwVbaBuiltInDocumentProperty::getName(  ) throw (script::BasicErrorException, uno::RuntimeException)
396 {
397     return mPropInfo.msMSODesc;
398 }
399 
400 void SAL_CALL
401 SwVbaBuiltInDocumentProperty::setName( const rtl::OUString& ) throw (script::BasicErrorException, uno::RuntimeException)
402 {
403     // not valid for Builtin
404     throw uno::RuntimeException();
405 }
406 
407 ::sal_Int8 SAL_CALL
408 SwVbaBuiltInDocumentProperty::getType(  ) throw (script::BasicErrorException, uno::RuntimeException)
409 {
410     return lcl_toMSOPropType( getValue().getValueType() );
411 }
412 
413 void SAL_CALL
414 SwVbaBuiltInDocumentProperty::setType( ::sal_Int8 /*Type*/ ) throw (script::BasicErrorException, uno::RuntimeException)
415 {
416     // not valid for Builtin
417     throw uno::RuntimeException();
418 }
419 
420 ::sal_Bool SAL_CALL
421 SwVbaBuiltInDocumentProperty::getLinkToContent(  ) throw (script::BasicErrorException, uno::RuntimeException)
422 {
423     return sal_False; // built-in always false
424 }
425 
426 void SAL_CALL
427 SwVbaBuiltInDocumentProperty::setLinkToContent( ::sal_Bool /*LinkToContent*/ ) throw (script::BasicErrorException, uno::RuntimeException)
428 {
429     // not valid for Builtin
430     throw uno::RuntimeException();
431 }
432 
433 uno::Any SAL_CALL
434 SwVbaBuiltInDocumentProperty::getValue(  ) throw (script::BasicErrorException, uno::RuntimeException)
435 {
436     uno::Any aRet = mPropInfo.getValue();
437     if ( !aRet.hasValue() )
438         throw uno::RuntimeException();
439     return aRet;
440 }
441 
442 void SAL_CALL
443 SwVbaBuiltInDocumentProperty::setValue( const uno::Any& Value ) throw (script::BasicErrorException, uno::RuntimeException)
444 {
445     mPropInfo.setValue( Value );
446 }
447 
448 rtl::OUString SAL_CALL
449 SwVbaBuiltInDocumentProperty::getLinkSource(  ) throw (script::BasicErrorException, uno::RuntimeException)
450 {
451     // not valid for Builtin
452     throw uno::RuntimeException();
453 }
454 
455 void SAL_CALL
456 SwVbaBuiltInDocumentProperty::setLinkSource( const rtl::OUString& /*LinkSource*/ ) throw (script::BasicErrorException, uno::RuntimeException)
457 {
458     // not valid for Builtin
459     throw uno::RuntimeException();
460 }
461 
462 rtl::OUString&
463 SwVbaBuiltInDocumentProperty::getServiceImplName()
464 {
465     static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("SwVbaBuiltinDocumentProperty") );
466     return sImplName;
467 }
468 
469 uno::Sequence<rtl::OUString>
470 SwVbaBuiltInDocumentProperty::getServiceNames()
471 {
472     static uno::Sequence< rtl::OUString > aServiceNames;
473     if ( aServiceNames.getLength() == 0 )
474     {
475         aServiceNames.realloc( 1 );
476         aServiceNames[ 0 ] = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ooo.vba.word.DocumentProperty" ) );
477     }
478     return aServiceNames;
479 }
480 typedef ::cppu::WeakImplHelper3< com::sun::star::container::XIndexAccess
481         ,com::sun::star::container::XNameAccess
482         ,com::sun::star::container::XEnumerationAccess
483         > PropertiesImpl_BASE;
484 
485 typedef std::hash_map< sal_Int32, uno::Reference< XDocumentProperty > > DocProps;
486 
487 typedef ::cppu::WeakImplHelper1< com::sun::star::container::XEnumeration > DocPropEnumeration_BASE;
488 class DocPropEnumeration : public DocPropEnumeration_BASE
489 {
490     DocProps mDocProps;
491     DocProps::iterator mIt;
492 public:
493 
494     DocPropEnumeration( const DocProps& rProps ) : mDocProps( rProps ), mIt( mDocProps.begin() ) {}
495     virtual ::sal_Bool SAL_CALL hasMoreElements(  ) throw (uno::RuntimeException)
496     {
497         return mIt != mDocProps.end();
498     }
499     virtual uno::Any SAL_CALL nextElement(  ) throw (container::NoSuchElementException, lang::WrappedTargetException, uno::RuntimeException)
500     {
501         if ( !hasMoreElements() )
502             throw container::NoSuchElementException();
503         return uno::makeAny( mIt++->second );
504     }
505 };
506 
507 typedef std::hash_map< rtl::OUString, uno::Reference< XDocumentProperty >, ::rtl::OUStringHash, ::std::equal_to< ::rtl::OUString > > DocPropsByName;
508 
509 class BuiltInPropertiesImpl : public PropertiesImpl_BASE
510 {
511 protected:
512 
513     uno::Reference< XHelperInterface > m_xParent;
514     uno::Reference< uno::XComponentContext > m_xContext;
515     uno::Reference< frame::XModel > m_xModel;
516     uno::Reference< document::XDocumentInfo > m_xOOOBuiltIns;
517 
518     DocProps mDocProps;
519     DocPropsByName mNamedDocProps;
520 
521     public:
522     BuiltInPropertiesImpl( const uno::Reference< XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext >& xContext, const uno::Reference< frame::XModel >& xModel ) : m_xParent( xParent ), m_xContext( xContext ), m_xModel( xModel )
523     {
524     	BuiltInIndexHelper builtIns( m_xModel );
525         for ( sal_Int32 index = word::WdBuiltInProperty::wdPropertyTitle; index <= word::WdBuiltInProperty::wdPropertyCharsWSpaces; ++index )
526         {
527             mDocProps[ index ] = new SwVbaBuiltInDocumentProperty( xParent, xContext, builtIns.getDocPropInfoMap()[ index ] );
528             mNamedDocProps[ mDocProps[ index ]->getName() ] = mDocProps[ index ];
529         }
530     }
531 // XIndexAccess
532     virtual ::sal_Int32 SAL_CALL getCount(  ) throw (uno::RuntimeException)
533     {
534         return mDocProps.size();
535     }
536     virtual uno::Any SAL_CALL getByIndex( ::sal_Int32 Index ) throw (lang::IndexOutOfBoundsException, lang::WrappedTargetException )
537     {
538         // correct the correct by the base class for 1 based indices
539         DocProps::iterator it = mDocProps.find( ++Index );
540         if ( it == mDocProps.end() )
541             throw lang::IndexOutOfBoundsException();
542         return uno::makeAny( it->second  );
543     }
544     virtual uno::Any SAL_CALL getByName( const ::rtl::OUString& aName ) throw (container::NoSuchElementException, lang::WrappedTargetException, uno::RuntimeException)
545     {
546         if ( !hasByName( aName ) )
547 		throw container::NoSuchElementException();
548         DocPropsByName::iterator it = mNamedDocProps.find( aName );
549         return uno::Any( it->second );
550 
551     }
552     virtual uno::Sequence< ::rtl::OUString > SAL_CALL getElementNames(  ) throw (uno::RuntimeException)
553     {
554         uno::Sequence< rtl::OUString > aNames( getCount() );
555         rtl::OUString* pName = aNames.getArray();
556         DocPropsByName::iterator it_end = mNamedDocProps.end();
557         for(  DocPropsByName::iterator it = mNamedDocProps.begin(); it != it_end; ++it, ++pName )
558            *pName = it->first;
559         return aNames;
560     }
561 
562     virtual ::sal_Bool SAL_CALL hasByName( const ::rtl::OUString& aName ) throw (uno::RuntimeException)
563     {
564         DocPropsByName::iterator it = mNamedDocProps.find( aName );
565         if ( it == mNamedDocProps.end() )
566             return sal_False;
567         return sal_True;
568     }
569 // XElementAccess
570     virtual uno::Type SAL_CALL getElementType(  ) throw (uno::RuntimeException)
571     {
572         return  XDocumentProperty::static_type(0);
573     }
574     virtual ::sal_Bool SAL_CALL hasElements(  ) throw (uno::RuntimeException)
575     {
576         return mDocProps.size() > 0;
577     }
578     virtual uno::Reference< container::XEnumeration > SAL_CALL createEnumeration(  ) throw (uno::RuntimeException)
579     {
580         return new DocPropEnumeration( mDocProps );
581     }
582 };
583 
584 SwVbaBuiltinDocumentProperties::SwVbaBuiltinDocumentProperties( const uno::Reference< XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext >& xContext, const uno::Reference< frame::XModel >& xModel ) : SwVbaDocumentproperties_BASE( xParent, xContext,  uno::Reference< container::XIndexAccess >( new BuiltInPropertiesImpl( xParent, xContext, xModel ) ) ), m_xModel( xModel )
585 {
586 }
587 
588 uno::Reference< XDocumentProperty > SAL_CALL
589 SwVbaBuiltinDocumentProperties::Add( const ::rtl::OUString& /*Name*/, ::sal_Bool /*LinkToContent*/, ::sal_Int8 /*Type*/, const uno::Any& /*value*/, const uno::Any& /*LinkSource*/ ) throw (script::BasicErrorException, uno::RuntimeException)
590 {
591     throw uno::RuntimeException(
592         rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("not supported for Builtin properties") ), uno::Reference< uno::XInterface >() );
593 }
594 
595 // XEnumerationAccess
596 uno::Type SAL_CALL
597 SwVbaBuiltinDocumentProperties::getElementType() throw (uno::RuntimeException)
598 {
599     return  XDocumentProperty::static_type(0);
600 }
601 
602 uno::Reference< container::XEnumeration > SAL_CALL
603 SwVbaBuiltinDocumentProperties::createEnumeration() throw (uno::RuntimeException)
604 {
605     uno::Reference< container::XEnumerationAccess > xEnumAccess( m_xIndexAccess, uno::UNO_QUERY_THROW );
606     return xEnumAccess->createEnumeration();
607 }
608 
609 // ScVbaCollectionBaseImpl
610 uno::Any
611 SwVbaBuiltinDocumentProperties::createCollectionObject( const uno::Any& aSource )
612 {
613     // pass through
614     return aSource;
615 }
616 
617 // XHelperInterface
618 rtl::OUString&
619 SwVbaBuiltinDocumentProperties::getServiceImplName()
620 {
621     static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("SwVbaBuiltinDocumentProperties") );
622     return sImplName;
623 }
624 
625 uno::Sequence<rtl::OUString>
626 SwVbaBuiltinDocumentProperties::getServiceNames()
627 {
628     static uno::Sequence< rtl::OUString > aServiceNames;
629     if ( aServiceNames.getLength() == 0 )
630     {
631         aServiceNames.realloc( 1 );
632         aServiceNames[ 0 ] = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ooo.vba.word.DocumentProperties" ) );
633     }
634     return aServiceNames;
635 }
636 
637 class CustomPropertiesImpl : public PropertiesImpl_BASE
638 {
639     uno::Reference< XHelperInterface > m_xParent;
640     uno::Reference< uno::XComponentContext > m_xContext;
641     uno::Reference< frame::XModel > m_xModel;
642     uno::Reference< beans::XPropertySet > mxUserDefinedProp;
643     boost::shared_ptr< PropertGetSetHelper > mpPropGetSetHelper;
644 public:
645     CustomPropertiesImpl( const uno::Reference< XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext >& xContext, const uno::Reference< frame::XModel >& xModel ) : m_xParent( xParent ), m_xContext( xContext ), m_xModel( xModel )
646     {
647         // suck in the document( custom ) properties
648         uno::Reference< document::XDocumentInfoSupplier > xDocInfoSupp( m_xModel, uno::UNO_QUERY_THROW );
649         uno::Reference< document::XDocumentPropertiesSupplier > xDocPropSupp( xDocInfoSupp->getDocumentInfo(), uno::UNO_QUERY_THROW );
650         uno::Reference< document::XDocumentProperties > xDocProp( xDocPropSupp->getDocumentProperties(), uno::UNO_QUERY_THROW );
651         mxUserDefinedProp.set( xDocProp->getUserDefinedProperties(), uno::UNO_QUERY_THROW );
652         mpPropGetSetHelper.reset( new CustomPropertyGetSetHelper( m_xModel ) );
653     };
654     // XIndexAccess
655     virtual ::sal_Int32 SAL_CALL getCount(  ) throw (uno::RuntimeException)
656     {
657         return mxUserDefinedProp->getPropertySetInfo()->getProperties().getLength();
658     }
659 
660     virtual uno::Any SAL_CALL getByIndex( ::sal_Int32 Index ) throw (lang::IndexOutOfBoundsException, lang::WrappedTargetException )
661     {
662         uno::Sequence< beans::Property > aProps = mxUserDefinedProp->getPropertySetInfo()->getProperties();
663         if ( Index >= aProps.getLength() )
664             throw lang::IndexOutOfBoundsException();
665         // How to determine type e.g Date? ( com.sun.star.util.DateTime )
666         DocPropInfo aPropInfo = DocPropInfo::createDocPropInfo( aProps[ Index ].Name, aProps[ Index ].Name, mpPropGetSetHelper );
667         return uno::makeAny( uno::Reference< XDocumentProperty >( new SwVbaCustomDocumentProperty( m_xParent, m_xContext, aPropInfo ) ) );
668     }
669 
670     virtual uno::Any SAL_CALL getByName( const ::rtl::OUString& aName ) throw (container::NoSuchElementException, lang::WrappedTargetException, uno::RuntimeException)
671     {
672         if ( !hasByName( aName ) )
673             throw container::NoSuchElementException();
674 
675         DocPropInfo aPropInfo = DocPropInfo::createDocPropInfo( aName, aName, mpPropGetSetHelper );
676         return uno::makeAny( uno::Reference< XDocumentProperty >( new SwVbaCustomDocumentProperty( m_xParent, m_xContext, aPropInfo ) ) );
677     }
678 
679     virtual uno::Sequence< ::rtl::OUString > SAL_CALL getElementNames(  ) throw (uno::RuntimeException)
680     {
681         uno::Sequence< beans::Property > aProps = mxUserDefinedProp->getPropertySetInfo()->getProperties();
682         uno::Sequence< rtl::OUString > aNames( aProps.getLength() );
683         rtl::OUString* pString = aNames.getArray();
684         rtl::OUString* pEnd = ( pString + aNames.getLength() );
685         beans::Property* pProp = aProps.getArray();
686         for ( ; pString != pEnd; ++pString, ++pProp )
687             *pString = pProp->Name;
688         return aNames;
689     }
690 
691     virtual ::sal_Bool SAL_CALL hasByName( const ::rtl::OUString& aName ) throw (uno::RuntimeException)
692     {
693         OSL_TRACE("hasByName(%s) returns %d", rtl::OUStringToOString( aName, RTL_TEXTENCODING_UTF8 ).getStr(), mxUserDefinedProp->getPropertySetInfo()->hasPropertyByName( aName ) );
694         return mxUserDefinedProp->getPropertySetInfo()->hasPropertyByName( aName );
695     }
696 
697     // XElementAccess
698     virtual uno::Type SAL_CALL getElementType(  ) throw (uno::RuntimeException)
699     {
700         return  XDocumentProperty::static_type(0);
701     }
702 
703     virtual ::sal_Bool SAL_CALL hasElements(  ) throw (uno::RuntimeException)
704     {
705         return getCount() > 0;
706     }
707 
708     virtual uno::Reference< container::XEnumeration > SAL_CALL createEnumeration(  ) throw (uno::RuntimeException)
709     {
710         // create a map of properties ( the key doesn't matter )
711         OSL_TRACE("Creating an enumeration");
712         sal_Int32 key = 0;
713         sal_Int32 nElem =  getCount();
714         DocProps simpleDocPropSnapShot;
715         for ( ; key < nElem; ++key )
716              simpleDocPropSnapShot[ key ].set( getByIndex( key ), uno::UNO_QUERY_THROW );
717         OSL_TRACE("After creating the enumeration");
718         return  new DocPropEnumeration( simpleDocPropSnapShot );
719     }
720 
721     void addProp( const ::rtl::OUString& Name, ::sal_Int8 /*Type*/, const uno::Any& Value )
722     {
723         sal_Int16 attributes = 128;
724         uno::Reference< beans::XPropertyContainer > xContainer( mxUserDefinedProp, uno::UNO_QUERY_THROW );
725         // TODO fixme, perform the necessary Type Value conversions
726         xContainer->addProperty( Name, attributes, Value );
727     }
728 
729 };
730 
731 
732 SwVbaCustomDocumentProperties::SwVbaCustomDocumentProperties( const uno::Reference< XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext >& xContext, const uno::Reference< frame::XModel >& xModel ) : SwVbaBuiltinDocumentProperties( xParent, xContext, xModel )
733 {
734     // replace the m_xIndexAccess implementation ( we need a virtual init )
735     m_xIndexAccess.set( new CustomPropertiesImpl( xParent, xContext, xModel ) );
736     m_xNameAccess.set( m_xIndexAccess, uno::UNO_QUERY_THROW );
737 }
738 
739 uno::Reference< XDocumentProperty > SAL_CALL
740 SwVbaCustomDocumentProperties::Add( const ::rtl::OUString& Name, ::sal_Bool LinkToContent, ::sal_Int8 Type, const uno::Any& Value, const uno::Any& LinkSource ) throw (script::BasicErrorException, uno::RuntimeException)
741 {
742     CustomPropertiesImpl* pCustomProps = dynamic_cast< CustomPropertiesImpl* > ( m_xIndexAccess.get() );
743     uno::Reference< XDocumentProperty > xDocProp;
744     if ( pCustomProps )
745     {
746         rtl::OUString sLinkSource;
747         pCustomProps->addProp( Name, Type, Value );
748 
749         xDocProp.set( m_xNameAccess->getByName( Name ), uno::UNO_QUERY_THROW );
750         xDocProp->setLinkToContent( LinkToContent );
751 
752         if ( LinkSource >>= sLinkSource )
753            xDocProp->setLinkSource( sLinkSource );
754     }
755     return xDocProp;
756 }
757 
758 // XHelperInterface
759 rtl::OUString&
760 SwVbaCustomDocumentProperties::getServiceImplName()
761 {
762     static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("SwVbaCustomDocumentProperties") );
763     return sImplName;
764 }
765